Shareware Overload Trio 2

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir44 / dungeon9.zip / DUNGEON.BAS < prev next >

Wrap

BASIC Source File | 1994-05-15 | 166KB | 4,723 lines

Rem The Dungeon 9.0 Main Program ' declare all variables as integer Defint A-Z ' declares variable storage for dungeon record structure type Type dungeontype dat(1 To 24,1 To 80) as integer scrn(1 To 24,1 To 80) as integer stats(1 To 32) as integer End Type ' declares variable storage for user record structure type Type usertype codename as string*32 password as string*32 spell(1 to 40) as integer wand(1 to 10) as integer potion(1 to 10) as integer staff(1 to 10) as integer ring(1 to 10) as integer globe(1 to 10) as integer stats1(1 to 6) as double stats2(1 to 17) as integer End Type ' standard error routine On Error Goto Error.Routine ' declare structures and arrays common to main program Dim userrec as usertype Dim dungeonrec as dungeontype Dim w(30,20) as Integer Dim v(30,20) as Integer Dim monsters(8,6) as Double Dim monstername(101) as String ' define function to convert 20 character string to encrypted string Def fnencrypt$(z$) i$="" For i=1 To 4 j#=0 j$=Mid$(z$,i*5-4,5) For q=1 To 5 j#=j#*1000+Asc(Mid$(j$,q,1)) Next i$=i$+Mkd$(j#) Next fnencrypt$=i$ End Def ' define function to convert encrypted string to 20 character string Def fndecrypt$(z$) i$="" For j=1 To 4 j$="" z#=Cvd(Mid$(z$,j*8-7,8)) For q=1 To 5 dvid#=Int(z#/1000) num#=z#-dvid#*1000 z#=dvid# j$=j$+Chr$(num#) Next y$=Left$(j$,1) Mid$(j$,1,1)=Mid$(j$,5,1) Mid$(j$,5,1)=y$ y$=Mid$(j$,2,1) Mid$(j$,2,1)=Mid$(j$,4,1) Mid$(j$,4,1)=y$ i$=i$+j$ Next fndecrypt$=i$ End Def Key Off ' disable function keys Screen 0 ' reset to default text screen Randomize Timer ' seed random number generator f$="ANSI.EXE" ' display welcome screen If Dir$(f$)=f$ Then ' determine if program exists Shell f$ ' call program Color 15,1 ' ansi color Locate 24,3 ' locate message Print "Press <enter> to continue to The Dungeon, or press <space> to exit to Dos:"; Do ' input loop I$=Inkey$ ' get input While I$="" ' wait for input I$=Inkey$ ' get input Wend ' end wait Select Case I$ ' choose input Case " " ' space Color 7,0 ' reset ansi Cls ' clear screen End ' end program Case Chr$(13) ' return pressed Exit Do ' exit input loop End Select ' end choose input Loop ' end input loop Endif ' end ansi shell Gosub Open.User.File ' open the users data file Restore Monster.Data ' read names of monsters from data For i=1 To 101 ' 100 monsters plus 1 demon Read monstername(i) ' load data into monster name array Next ' end load loop Do ' main program loop ' user presses enter to play, ' or another key to exit program. Color 14, 1 ' blue background Cls ' clear screen Locate 10,27,0 ' locate for message Color 14 ' yellow color Print Chr$(201); ' print ascii character Print String$(25,Chr$(205)); ' print ascii character Print Chr$(187); ' print ascii character Locate 11,27,0 ' position cursor Print Chr$(186); ' print ascii character Color 15 ' ansi color Print " Welcome to the "; Color 28 ' ansi color Print "Dungeon! "; Color 14 ' ansi color Print Chr$(186); ' print ascii character Locate 12,27,0 ' position cursor Print Chr$(186); ' print ascii character Color 15 ' ansi color Print " Hit "; Color 10 ' ansi color Print "<enter>"; Color 15 ' ansi color Print " to play or "; Color 14 ' ansi color Print Chr$(186); ' print ascii character Locate 13,27,0 ' position cursor Print Chr$(186); ' print ascii character Color 15 ' ansi color Print " any other key to quit.. "; Color 14 ' ansi color Print Chr$(186); ' print ascii character Locate 14,27,0 ' position cursor Print Chr$(200); ' print ascii character Print String$(25,Chr$(205)); ' print ascii character Print Chr$(188); ' print ascii character Locate 15,33,0 ' position cursor Color 15 ' ansi color Print "Turn on Numlock"; Color 7 ' ansi color x$="" ' get keystroke While x$="" ' wait for input x$=Inkey$ ' get keystroke Wend ' end wait If x$<>Chr$(13) Then Exit Do Endif For i=1 To 8 ' clear monster array For j=1 To 6 ' of all statistics monsters(i,j)=0 ' set to zero Next ' end clear loop Next ' end clear loop Do ' loop to get user codename into code$ and password into pass$ Color 14, 1 ' blue background Cls ' clear screen Locate 11,25,0 ' locate for message Color 14 ' yellow color Print "Before you enter the "; Color 13 ' ansi color Print "Dungeon,"; Locate 12,25,0 ' position cursor Color 14 ' ansi color Print "you must inscibe your name in"; Locate 13,25,0 ' position cursor Print " the book of adventurers."; Color 10 ' ansi color Locate 15,28,0 ' position cursor Print Chr$(201); ' print ascii character Print String$(20,Chr$(205)); ' print ascii character Print Chr$(187); ' print ascii character Locate 16,49,0 ' position cursor Print Chr$(186); ' block character Locate 17,49,0 ' position cursor Print Chr$(188); ' block character For i=48 To 29 Step -1 Locate 17,i,0 ' position cursor Print Chr$(205); ' block character Next Locate 17,28,0 ' position cursor Print Chr$(200); ' block character Locate 16,28,0 ' position cursor Print Chr$(186); ' block character Locate 16,29,1 ' position cursor Color 15 ' ansi color ' loop to retrieve code$ character by character. ' backspace, enter, and characters A to Z are accepted, ' otherwise a beep, or beep for backspace before column one, ' or beep for enter with no characters input. Maximum 20 characters. code$="" ' clear code$ Do x$="" ' get keystroke While x$="" ' wait for input x$=Inkey$ ' get keystroke Wend ' end wait Select Case x$ Case Chr$(13)' enter key If Len(code$) Then Exit Do ' exit loop Endif Beep ' warning signal Case Chr$(8) ' backspace If Len(code$)=0 Then Beep ' warning signal Else Locate 16,Pos(0)-1,1 ' position cursor Print " "; Locate 16,Pos(0)-1,1 ' position cursor code$=Left$(code$,Len(code$)-1) ' truncate input string one character Endif Case "a" To "z", "A" To "Z", " " ' check valid character If Len(code$)=20 Then ' verify length of string Beep ' warning signal Else code$=code$+x$ ' append to code$ Print x$; Endif End Select Loop Locate 19,25,0 ' position cursor Print "Now inscribe your secret name."; Color 10 ' ansi color Locate 21,28,0 ' position cursor Print Chr$(201); ' print ascii character Print String$(20,Chr$(205)); ' print ascii character Print Chr$(187); ' print ascii character Locate 22,49,0 ' position cursor Print Chr$(186); ' block character Locate 23,49,0 ' position cursor Print Chr$(188); ' block character For i=48 To 29 Step -1 Locate 23,i,0 ' position cursor Print Chr$(205); ' block character Next Locate 23,28,0 ' position cursor Print Chr$(200); ' block character Locate 22,28,0 ' position cursor Print Chr$(186); ' block character Locate 22,29,1 ' position cursor Color 15 ' ansi color ' loop to retrieve pass$ character by character. ' backspace, enter, and characters A to Z are accepted, ' otherwise a beep, or beep for backspace before column one, ' or beep for enter with no characters input. Maximum 20 characters. pass$="" ' clear pass$ Do x$="" ' get keystroke While x$="" ' wait for input x$=Inkey$ ' get keystroke Wend ' end wait Select Case x$ Case Chr$(13) ' enter key If Len(pass$) Then Color 7 ' ansi color Exit Do ' exit loop Endif Beep ' warning signal Case Chr$(8) ' backspace If Len(pass$)=0 Then Beep ' warning signal Else Locate 22,Pos(0)-1,1 ' position cursor Print " "; Locate 22,Pos(0)-1,1 ' position cursor pass$=Left$(pass$,Len(pass$)-1) ' truncate input string one character Endif Case "a" To "z", "A" To "Z", " " ' check valid character If Len(pass$)=20 Then ' verify length of string Beep ' warning signal Else pass$=pass$+x$ ' append to pass$ Print "."; Endif End Select Loop code$=code$+String$(20-Len(code$),32) ' pad with spaces to the right code$=Lcase$(code$) ' convert codename to lowercase pass$=pass$+String$(20-Len(pass$),32) ' pad with spaces to the right pass$=Lcase$(pass$) ' convert password to lowercase ' find existing codename in users data file, or new user login=0 new.user=-1 ' get each users data file record one by one For ux=1 To Lof(1)/Len(userrec) ' get the data file record Get 1,ux,userrec ' get the decrypted codename xcrypt$=fndecrypt$(userrec.codename) ' check for an existing codename If code$=xcrypt$ Then ' get the decrypted password ycrypt$=fndecrypt$(userrec.password) ' if existing users password does not match, ' set flag for no login. If pass$=ycrypt$ Then login=-1 Endif ' not a new user if codename found new.user=0 Exit For ' exit the loop after finding and checking password Endif Next ' the codename was not found.. a new user. If new.user Then ' reset all variables for new user dlvl#=1 userrec.stats1(1)=1 userrec.stats1(2)=1 userrec.stats1(3)=64 userrec.stats1(4)=15 userrec.stats1(5)=0 userrec.stats1(6)=15 For i=1 To 12 userrec.stats2(i)=0 Next For i=13 To 16 userrec.stats2(i)=10 Next userrec.stats2(17)=0 For i=1 To 10 userrec.wand(i)=0 userrec.potion(i)=0 userrec.staff(i)=0 userrec.ring(i)=0 userrec.globe(i)=0 Next For i=1 To 40 userrec.spell(i)=0 Next Color 14, 1 ' blue background Cls ' get the new users statistics Locate 11,28,0 ' position cursor Color 12 ' ansi color Print "Str Int Wis Con Dex Cha"; ' display statistic header Locate 13,15,0 ' position cursor Color 13 ' ansi color Print "Rolling Character Stats(5 to keep or 9 to ignore)"; ' loop to randomly select 6 statistics, ' and exit loop after user presses enter Do Locate 12,29,0 ' position cursor Color 10 ' ansi color For x=1 To 6 m=Int(Rnd*9+10) userrec.stats2(x)=m ' random statistic Print Right$(Str$(m),2)+" "; Next Do ' get a keystroke Gosub Get.Keystroke Loop Until x=5 Or x=9 ' exit statistics loop when enter/5 is pressed If x=5 Then Locate 15,11,0 ' position cursor Color 15 ' ansi color Print "Press 0 for help when playing, and Q to quit. Now hit a key."; Color 7 ' ansi color Gosub Get.Key.Press ' get a single keystroke Gosub Put.User.File ' store users record to data file login=-1 ' set logged in variable Exit Do Endif Loop Endif ' if user has logged in (by rolling new character statistics, or ' by matching password to existing codename).. If login Then Gosub Open.Data.File ' open the users data file Get 1,ux,userrec ' ux is the user index to the data file Gosub Change.Level ' ask user to select level to start on Do ' main input loop Gosub Status.Line ' display statistics on line 24 x$="" ' get keystroke While x$="" ' wait for input x$=Inkey$ ' get keystroke Wend ' end wait ' determine key pressed Select Case Len(x$) Case 1 Select Case x$ Case "1" ' attack nearby monsters Gosub Attack.Nearby.Monsters Gosub Monster.Attack Gosub Encounter.Cells Case "2" ' move player down Gosub Move.Player.Down Case "3" ' get user to enter a spell chant to cast Gosub Cast.Chant Case "4" ' move player left Gosub Move.Player.Left Case "5", Chr$(13) ' enter key/null action/update hits Gosub Update.Hits Case "6" ' move player right Gosub Move.Player.Right Case "7" ' move player away from nearby monster Gosub Evade.Monster Case "8" ' move player up Gosub Move.Player.Up Case "9" ' ignore key/null action/update hits Gosub Update.Hits Case "0" ' help screen menu Gosub Display.Help Case "+" ' display dungeon information Gosub Display.Info Case "." ' display extended status line 25 Gosub Extended.Status.Line Case "-" ' learned spells display screen Gosub Learned.Spells Case "\" ' statistic trading menu Gosub Trade.Stats Case ";" ' inventory purchasing menu Gosub Buy.Inventory Case "=" ' reselect dungeon level number Gosub Store.Dungeon.Level ' store dungeon screen Gosub Change.Level Case "/" ' inventory display screen Gosub Inventory Case "'" ' use magic item menu Gosub Use.Item Gosub Cell.Action ' compute nearby cells Case "`" ' user list Gosub User.List Case "Q", "q" ' quit the dungeon Gosub Store.Dungeon.Level ' store dungeon screen Gosub Put.User.File dlvl#=0 ' dungeon level zero/exit flag login=0 ' set logged in variable false Case Chr$(1) to Chr$(10) i=Asc(x$) ' use a staff number 1 to 10 Gosub Use.Staff Case Chr$(17) to Chr$(26) i=Asc(x$)-16 ' use a ring number 1 to 10 Gosub Use.Ring Case Else Color 13 ' ansi color a$="Type 0 for help, or Q to quit.." ' make display message Gosub Display.Message ' output message End Select Case 2 sp=Asc(Mid$(x$,2)) spn=0 Select Case sp ' use a wand extended keys 1 to 10 Case 30 i=1 Gosub Use.Wand Case 48 i=2 Gosub Use.Wand Case 46 i=3 Gosub Use.Wand Case 32 i=4 Gosub Use.Wand Case 18 i=5 Gosub Use.Wand Case 33 i=6 Gosub Use.Wand Case 34 i=7 Gosub Use.Wand Case 35 i=8 Gosub Use.Wand Case 23 i=9 Gosub Use.Wand Case 36 i=10 Gosub Use.Wand ' use a potion extended keys 1 to 10 Case 16 i=1 Gosub Use.Potion Case 19 i=2 Gosub Use.Potion Case 31 i=3 Gosub Use.Potion Case 20 i=4 Gosub Use.Potion Case 22 i=5 Gosub Use.Potion Case 47 i=6 Gosub Use.Potion Case 17 i=7 Gosub Use.Potion Case 45 i=8 Gosub Use.Potion Case 21 i=9 Gosub Use.Potion Case 44 i=10 Gosub Use.Potion ' F1 to F10, cast spell type 1 Case 59 To 68 spn=1 sp=sp-58 Gosub Cast.Spell.Type1 ' Control-F1 to F10, cast spell type 2 Case 94 To 103 spn=2 sp=sp-93 Gosub Cast.Spell.Type2 ' Shift-F1 to F10, cast spell type 3 Case 84 To 93 spn=3 sp=sp-83 Gosub Cast.Spell.Type3 ' Alt-F1 to F10, cast spell type 4 Case 104 To 113 spn=4 sp=sp-103 Gosub Cast.Spell.Type4 ' extended keys equal to numeric keypad entry Case 79 ' 1, attack nearby monsters Gosub Attack.Nearby.Monsters Gosub Monster.Attack Gosub Encounter.Cells Case 80 ' 2, move player down Gosub Move.Player.Down Case 81 ' 3, cast spell Gosub Cast.Chant Case 75 ' 4, move player left Gosub Move.Player.Left Case 76 ' 5, enter/accept Gosub Update.Hits Case 77 ' 6, move player right Gosub Move.Player.Right Case 71 ' 7, evade monster Gosub Evade.Monster Case 72 ' 8, move player up Gosub Move.Player.Up Case 73 ' 9, ignore key/null action/update hits Gosub Update.Hits Case 82 ' help screen menu Gosub Display.Help Case 116 ' display dungeon information Gosub Display.Info Case 83 ' display extended status line 25 Gosub Extended.Status.Line Case 118 ' learned spells display screen Gosub Learned.Spells Case 119 ' statistic trading menu Gosub Trade.Stats Case 15 ' inventory purchasing menu Gosub Buy.Inventory Case 117 ' reselect dungeon level number Gosub Store.Dungeon.Level ' store dungeon screen Gosub Change.Level Case 115 ' inventory display screen Gosub Inventory Case 132 ' use magic item menu Gosub Use.Item Gosub Cell.Action ' compute nearby cells ' Alt-0 to Alt-9, globe power keys Case 120 To 129 i=Asc(Mid$(x$,2))-119 Gosub Use.Globe Case 131 ' user list Gosub User.List End Select End Select Loop Until login=0 Endif Loop Until dlvl#=0 Loop Color 7, 0 ' reset color Cls ' clear screen End ' terminate program ' display message containing the spell cast Cast.Spell.Message: Restore Spell.Data ' reset the data pointer to the spell names ' loop to the spell number (sp=spell number, spn=spell type 1 to 4) For i=1 to sp+(spn-1)*10 Read a$, c$ ' read the spell chant and name Next Color 15 ' ansi color a$="You cast a "+c$+" spell!" ' make display message Gosub Display.Message ' output message Color 7 ' ansi color Return ' exit routine Move.Player.Down: d=dungeonrec.dat(xco+1,yco) ' if the player tries to move through a dungeon ' wall and is not in passwall mode then exit If d=176 Then If pwl=0 Then Return ' exit routine Endif Endif ' if the player moves to a cell occupied by a monster, ' use the move as an attack on the monster If d=35 Then mxco=xco+1 ' set monster coordinates myco=yco Gosub Attack.Monster Gosub Monster.Attack Gosub Encounter.Cells Return ' exit routine Endif ' otherwise move player down If xco<23 Then xco=xco+1 ' update player x-coordinate Gosub Update.Player ' update nearby cell actions Endif Return ' exit routine Move.Player.Left: d=dungeonrec.dat(xco,yco-1) ' if the player tries to move through a dungeon ' wall and is not in passwall mode then exit If d=176 Then If pwl=0 Then Return ' exit routine Endif Endif ' if the player moves to a cell occupied by a monster, ' use the move as an attack on the monster If d=35 Then mxco=xco ' set monster coordinates myco=yco-1 Gosub Attack.Monster Gosub Monster.Attack Gosub Encounter.Cells Return ' exit routine Endif ' otherwise move player left If yco>1 Then yco=yco-1 ' update player y-coordinate Gosub Update.Player ' update nearby cell actions Endif Return ' exit routine Move.Player.Right: ' if the player tries to move through a dungeon ' wall and is not in passwall mode then exit d=dungeonrec.dat(xco,yco+1) If d=176 Then If pwl=0 Then Return ' exit routine Endif Endif ' if the player moves to a cell occupied by a monster, ' use the move as an attack on the monster If d=35 Then mxco=xco ' set monster coordinates myco=yco+1 Gosub Attack.Monster Gosub Monster.Attack Gosub Encounter.Cells Return ' exit routine Endif ' otherwise move player right If yco<79 Then yco=yco+1 ' update player y-coordinate Gosub Update.Player ' update nearby cell actions Endif Return ' exit routine Move.Player.Up: d=dungeonrec.dat(xco-1,yco) ' if the player tries to move through a dungeon ' wall and is not in passwall mode then exit If d=176 Then If pwl=0 Then Return ' exit routine Endif Endif ' if the player moves to a cell occupied by a monster, ' use the move as an attack on the monster If d=35 Then mxco=xco-1 ' set monster coordinates myco=yco Gosub Attack.Monster Gosub Monster.Attack Gosub Encounter.Cells Return ' exit routine Endif ' otherwise move player up If xco>1 Then xco=xco-1 ' update player x-coordinate Gosub Update.Player ' update nearby cell actions Endif Return ' exit routine ' actions for cells next to a player when he moves Update.Player: llc=llc-1 ' decrement extended cell display counter If llc<0 Then ' check extended cell display counter ll=1 ' reset cell displays cell display amount llc=0 ' reset extended cell display counter Endif gdc=gdc-1 ' decrement extended monster cell death counter If gdc<0 Then ' check extended monster cell death counter gd=0 ' reset cell monster death flag gdc=0 ' reset extended monster cell death counter Endif ' surrounding cell monster deaths If gd Then Gosub Cell.Monster.Attack ' all nearby monsters die Endif ' further cell action routine Gosub Cell.Action ' compute nearby cells ' player moves to an occupied cell Select Case dungeonrec.dat(xco,yco) Case 33 ' teleporter (!) Gosub Teleporter Case 34 ' ring (") Gosub Ring Case 36 ' pile of coins ($) Gosub Find.Coin.Pile Case 37 ' staff (%) Gosub Staff Case 38 ' coins (&) Gosub Coins Case 42 ' gems (*) Gosub Gems Case 60 ' staircase down (<) Gosub Stairs.Down Case 62 ' staircase up (>) Gosub Stairs.Up Case 63 ' temple (?) Gosub Temple Case 64 ' potion (@) Gosub Potion Case 94 ' trap (^) Gosub Trap Case 111 ' pit (o) Gosub Pit Case 124 ' wand (|) Gosub Wand Case 126 ' scroll (~) Gosub Scroll Case 254 ' chest symbol Gosub Find.Chest End Select Gosub Check.Clear.Dungeon Gosub Update.Hits Return ' exit routine ' check if all treasure have been found Check.Clear.Dungeon: If dungeonrec.stats(5)=1 Then ' all monsters in dungeon level conquered If dungeonrec.stats(4)=0 Then ' all treasure found flag not set For x=8 To 32 Step 2 ' loop through dungeon treasure flags If dungeonrec.stats(x)=0 Then ' check any treasure not found Return ' exit routine Endif Next dungeonrec.stats(4)=1 ' set all dungeon level treasure found flag d$="treasure" Gosub Treasure.Bonus ' bonus for all treasure Color 13 ' ansi color a$="The dungeon becomes replenished!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Gosub Zero.Dungeon ' first remove all dungeon treasure, Gosub Replenish.Dungeon ' restock the dungeon level Endif Endif Return ' exit routine ' calculate award amount of gold for a bonus Treasure.Bonus: ' calculate gold award ex#=(Rnd*dlvl#*2+1)*userrec.stats1(2)^2/2 ex#=ex#+dlvl#*2+Rnd*userrec.stats1(2)*50 ex#=Int(ex#) userrec.stats1(5)=userrec.stats1(5)+ex# ' increment players gold Color 14 ' ansi color a$="You found all the "+d$+" on this level! You gain"+Str$(ex#)+" gold!" Gosub Display.Message ' output message Gosub Pause.Second ' wait Return ' exit routine ' calculate when to update players combat hits Update.Hits: cnt=cnt+1 ' increment counter each input loop pass ' return if counter below 10 If cnt<10 Then Return ' exit routine Endif cnt=0 ' reset counter Gosub Increment.Hits ' update players combat hits Return ' exit routine ' calculate players incremented combat hits Increment.Hits: x=userrec.stats1(6) ' maximum hit points y=userrec.stats1(4) ' user's hit points z=userrec.stats2(4) ' constitution If x>y Then ' increment plus constitution y=y+z Endif If y>x Then ' reset to maximum points allowed if over maximum y=x Endif userrec.stats1(4)=y Return ' exit routine ' move player up stairs Stairs.Up: Color 14 ' ansi color a$="You find a staircase!(5 to climb up or 9 to ignore)" Gosub Display.Message ' output message Do ' get a keystroke Gosub Get.Keystroke Loop Until x=5 Or x=9 ' presses enter/5 to climb up If x=5 Then Gosub Dungeon.Level.Up ' move player up one dungeon level Endif Return ' exit routine ' move player down stairs Stairs.Down: Color 14 ' ansi color a$="You find a staircase!(5 to climb down or 9 to ignore)" Gosub Display.Message ' output message Do ' get a keystroke Gosub Get.Keystroke Loop Until x=5 Or x=9 ' presses enter/5 to climb down If x=5 Then Gosub Dungeon.Level.Down ' move player down one dungeon level Endif Return ' exit routine ' redisplay staircase up symbol, ' then enter routine to next dungeon level up Dungeon.Level.Up: Color 15 ' ansi color Locate xco,yco,0 ' position cursor Print ">"; ' make stair symbol ' move player up one dungeon level Dungeon.Up: Gosub Clear.Status.Line2 ' clear status line area Gosub Store.Dungeon ' record the dungeon statistics and screen Gosub Decrement.Dungeon.Level ' subtract one from dungeon level variable If dlvl#>0 Then ' still in dungeon Color 10 ' ansi color a$="You return to Dungeon level"+Str$(dlvl#)+"!(hit a key)" ' prompt Gosub Display.Message ' display next dungeon level reached message Gosub Get.Key.Press ' get a single keystroke Gosub Next.Dungeon.Level ' load dungeon level statistics Gosub Cell.Action ' compute nearby cells Endif Return ' exit routine Decrement.Dungeon.Level: dlvl#=dlvl#-1 ' decrement players dungeon level counter If dlvl#<=0 Then ' if the player reaches dungeon level zero, exit game login=0 ' player leaves dungeon dlvl#=0 ' reset dungeon level counter to zero Color 14 ' ansi color a$="You escaped the Dungeon!(hit a key)" Gosub Display.Message ' output message Gosub Get.Key.Press ' get a single keystroke Gosub Put.User.File ' store players dungeon level statistics Endif Return ' exit routine ' redisplay staircase down symbol, ' then enter routine to next dungeon level down Dungeon.Level.Down: Color 15 ' ansi color Locate xco,yco,0 ' position cursor Print "<"; ' make stair symbol ' move player down one dungeon level Dungeon.Down: Gosub Clear.Status.Line2 ' clear status line area Gosub Store.Dungeon ' record the dungeon statistics and screen Gosub Increment.Dungeon.Level Return ' exit routine Increment.Dungeon.Level: dlvl#=dlvl#+1 ' increment players dungeon level counter ' check if player has entered a dungeon level lower than his last recorded If dlvl#>userrec.stats1(1) Then userrec.stats1(1)=dlvl# ' if lower, set players last dungeon level to current Endif Color 11 ' ansi color a$="You made it to Dungeon level"+Str$(dlvl#)+"!(hit a key)" ' message Gosub Display.Message ' display next dungeon level reached message Gosub Get.Key.Press ' get a single keystroke Gosub Next.Dungeon.Level ' load dungeon level statistics Gosub Cell.Action ' compute nearby cells Return ' exit routine ' loads dungeon level statistics Next.Dungeon.Level: xdlvl#=dlvl# ' store dungeon level While xdlvl#>Lof(2)/Len(dungeonrec) ' new dungeon record, dlvl#=Lof(2)/Len(dungeonrec)+1 ' reset dungeon level Gosub Make.Dungeon ' create the dungeon level Gosub Store.Dungeon ' store new dungeon level Wend Gosub Load.Dungeon.Level ' get the dungeon level from data file on disk Return ' exit routine ' clears status line before storing dungeon level Store.Dungeon.Level: Gosub Clear.Status.Line ' clear status line ' stores current dungeon level screen Store.Dungeon: ' store the dungeon screen For i=1 to 24 ' rows by For j=1 to 80 ' columns ' move character at screen location into data file array dungeonrec.scrn(i,j)=screen(i,j) Next Next dungeonrec.stats(2)=xco ' player x-coordinate dungeonrec.stats(3)=yco ' player y-coordinate ' calculate the number of levels stored, the length of the data file divided ' by the length of the structure, check if recording the dungeon level would ' access any record number out of range, If dlvl#<=Lof(2)/Len(dungeonrec)+1 Then ' check valid level Put 2,dlvl#,dungeonrec ' store the dungeon level structure into record Endif Return ' exit routine ' selects specific dungeon level previously recorded Change.Level: If Lof(2)/Len(dungeonrec)=0 Then ' dungeon records in the data file dlvl#=1 ' reset the dungeon level counter to one Gosub Make.Dungeon ' create the first dungeon level Gosub Store.Dungeon ' store new dungeon level Gosub Cell.Action ' compute nearby cells Return ' exit routine Endif If Lof(2)/Len(dungeonrec)=1 Then ' dungeon records in the data file Color 14, 1 ' blue background Cls ' clear screen Locate 12,24,0 ' position cursor Color 13 ' ansi color Print "You Will Start At Dungeon Level 1"; ' display dungeon level Color 7 ' ansi color Gosub Pause.Second ' wait Gosub Pause.Second ' wait Gosub Pause.Second ' wait ll=1 ' reset cell displays cell display amount dlvl#=1 ' set dungeon level variable Gosub Load.Dungeon.Level ' load the dungeon statistics and screen Gosub Cell.Action ' compute nearby cells Return ' exit routine Endif Do ' loop to get dungeon level input into l$ ' calculate the number of levels stored, the length of the data file ' divided by the length of the structure, if there are no Color 14, 1 ' blue background Cls ' clear screen i$="You made it as far as level"+Str$(Lof(2)/Len(dungeonrec))+"!" ' make prompt i=40-Int(len(i$)/2) ' calculate prompt center Locate 10,i,0 ' position cursor Color 14 ' ansi color Print "You made it as far as level";Str$(Lof(2)/Len(dungeonrec));"!"; Locate 11,23,0 ' position cursor Color 10 ' ansi color Print "Which level will you start at now?" ' display input prompt Color 15 ' ansi color l$="" ' clear input Locate 13,30,1 ' position cursor ' loop to retrieve l$ input character by character. ' backspace, enter, and characters 0 to 9 are accepted, ' otherwise a beep, or beep for backspace before column one, ' or beep for enter with no characters input. Maximum 8 characters. Do x$="" ' get keystroke While x$="" ' wait for input x$=Inkey$ ' get keystroke Wend ' end wait Select Case x$ ' select user input Case Chr$(13) ' enter key If Len(l$) Then Exit Do ' exit loop Endif Beep ' warning signal Case Chr$(8) ' backspace If Len(l$)=0 Then Beep ' warning signal Else Locate Csrlin,Pos(0)-1,1 ' position cursor Print " "; Locate Csrlin,Pos(0)-1,1 ' position cursor l$=Left$(l$,Len(l$)-1) ' truncate input string one character Endif Case "0" To "9" ' check valid character If Len(l$)=8 Then ' verify length of string Beep ' warning signal Else l$=l$+x$ ' append to l$ Print x$; Endif End Select Loop dlvl#=Val(l$) ' convert l$ to dungeon level variable ' if the dungeon level is within range of the records in the data file, If dlvl#>0 And dlvl#<=Lof(2)/Len(dungeonrec) Then ll=1 ' reset cell displays cell display amount Gosub Load.Dungeon.Level ' load the dungeon statistics and screen Gosub Cell.Action ' compute nearby cells Exit Do ' exit the loop Endif ' otherwise, display message i$="You have only"+Str$(Lof(2)/Len(dungeonrec))+" to choose from.." i=40-Int(Len(i$)/2+1) ' calculate prompt center Locate 15,i,0 ' position cursor Color 13 ' ansi color Print "You have only";Str$(Lof(2)/Len(dungeonrec));" levels to choose from." Color 7 ' ansi color Locate 13,30,0 ' position cursor Print Space$(8); Gosub Key.Press ' get a keystroke Loop Return ' exit routine ' redisplay dungeon dot, then clear status line area Clear.Status.Line: Color 7 ' ansi color Locate xco,yco,0 ' position cursor Print "."; ' dungeon dot ' clear status line area Clear.Status.Line2: color 7 ' ansi color Locate 24,1,0 ' position cursor Print Space$(79); Locate 25,1,0 ' position cursor Print Space$(79); Return ' exit routine ' load dungeon level from data file on disk Load.Dungeon.Level: ' if there are less dungeon record structures recorded in the data file ' than the dungeon level requested to read from, If Lof(2)/Len(dungeonrec)<dlvl# Then Gosub Make.Dungeon ' then the dungeon level is created, Gosub Store.Dungeon ' store new dungeon level Gosub Cell.Action ' compute nearby cells Return ' exit routine Endif ' otherwise, read the dungeon record structure ' restores dungeon screen Restore.Screen: ' read the dungeon record structure Get 2,dlvl#,dungeonrec Color 14, 1 ' blue background Cls ' clear the screen For i=1 to 24 ' rows by For j=1 to 79 ' columns Locate i,j,0 ' locate at dungeon xy ' display character in dungeon screen array on screen x=dungeonrec.scrn(i,j) ' get character If x=32 Then ' blank space Locate Csrlin,Pos(0)+1,0 ' increment cursor y position Else If x=46 Or x=176 Then ' color white for k=dungeonrec.dat(i,j) ' ascii of dungeon coordinate If k>21 And k<26 Then ' compare dot Color 15 ' dungeon room border Else ' color dot Color 7 ' dungeon dot/wall Endif Else ' color highlight white for Color 15 ' other symbols Endif Print Chr$(x); ' print ascii character Endif Next Color 7 ' display rightmost column If dungeonrec.scrn(i,j)=176 Then ' dungeon wall Print Chr$(176); ' print ascii character Endif Next xco=dungeonrec.stats(2) ' player x-coordinate yco=dungeonrec.stats(3) ' player y-coordinate Color 15 ' display player's character Locate xco,yco,0 ' in highlight white Print "X"; Return ' enter a teleporter Teleporter: dungeonrec.dat(xco,yco)=46 ' reset cell with dungeon dot Color 14 ' ansi color a$="You find a teleporter!(5 to enter or 9 to ignore)" Gosub Display.Message ' output message Do ' get a keystroke Gosub Get.Keystroke Loop Until x=5 Or x=9 ' presses enter/5 to enter teleporter If x=5 Then Color 7 ' ansi color Locate xco,yco,0 ' position cursor Print "."; ' replace character X with dungeon dot ' teleport player based on wisdom If Int(Rnd*8+8)>userrec.stats2(3) Then Gosub Teleport Else ' otherwise, teleport one dungeon level If Rnd>.5 Then Gosub Dungeon.Up ' up random 50/50 Else Gosub Dungeon.Down ' or down random 50/50 Endif Endif Endif ' no action for ignore/9 dungeonrec.stats(15)=dungeonrec.stats(15)-1 ' decrement dungeon teleporters If dungeonrec.stats(15)=0 Then ' player has entered last teleporter If dungeonrec.stats(16)=0 Then dungeonrec.stats(16)=1 ' set all dungeon level teleporter flag Endif Endif Return ' exit routine ' enter temple Temple: dungeonrec.dat(xco,yco)=46 ' reset cell with dungeon dot Color 14 ' ansi color a$="You find a temple!(5 to pray, 7 to pillage, or 9 to ignore)" Gosub Display.Message ' output message Do ' get a keystroke Gosub Get.Keystroke Loop Until x=5 Or x=7 Or x=9 ' presses enter/5 to pray or evade/7 to pillage If x=5 Then ' reward player based on charisma If Int(Rnd*8+8)>userrec.stats2(6) Then ' low charisma Color 10 ' ansi color a$="Nothing happens.." ' make display message Gosub Display.Message ' output message Else ' high charisma Color 10 ' ansi color a$="You are rewarded with great treasure!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Gosub Coin.Pile Endif Else ' pillage/7 is pressed If x=7 Then ' reward player based on charisma If Int(Rnd*8+8)>userrec.stats2(6) Then ' low charisma Color 10 ' ansi color a$="The Ghods are angered!" ' make display message mhp#=0 ' set hits to zero for Gosub Hit.Player ' routine to calculate hits on player Else ' high charisma Color 10 ' ansi color a$="You are rewarded with great treasure!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Gosub Chest ' opens a chest Endif Endif Endif ' no action for ignore/9 dungeonrec.stats(17)=dungeonrec.stats(17)-1 ' decrement dungeon level temple If dungeonrec.stats(17)=0 Then ' player has entered last temple If dungeonrec.stats(18)=0 Then dungeonrec.stats(18)=1 ' set all dungeon level temple flag Endif Endif Return ' exit routine ' find gems Gems: dungeonrec.dat(xco,yco)=46 ' reset cell with dungeon dot ' select gem type ran!=Rnd ' based on percentage If ran!>.85 Then bonus=8 ' multiplier b$="diamonds" ' gem name Else If ran!>.75 Then bonus=5 ' multiplier b$="emeralds" ' gem name Else If ran!>.50 Then bonus=3 ' multiplier b$="saphires" ' gem name Else bonus=2 ' multiplier b$="rubies" ' gem name Endif Endif Endif Color 14 ' ansi color a$="You find some "+b$+"!" ' make display message Gosub Display.Message ' output message ' calculate increment to players gold by bonus multiplier temp#=Rnd*userrec.stats1(2) temp#=temp#+Rnd*userrec.stats1(2)+10 temp#=Int(temp#*bonus) userrec.stats1(5)=userrec.stats1(5)+temp# dungeonrec.stats(19)=dungeonrec.stats(19)-1 ' decrement dungeon level gems If dungeonrec.stats(19)=0 Then ' player has taken last gem If dungeonrec.stats(20)=0 Then dungeonrec.stats(20)=1 ' set all dungeon level gem flag d$="gems" Gosub Treasure.Bonus ' bonus for last gem Endif Endif Return ' exit routine ' find coins Coins: dungeonrec.dat(xco,yco)=46 ' reset cell with dungeon dot bonus=Int(Rnd*dlvl#+5) ' number of coins Color 14 ' ansi color a$="You find"+Str$(bonus)+" coins!" ' make display message Gosub Display.Message ' output message ' calculate increment to players gold by bonus multiplier userrec.stats1(5)=userrec.stats1(5)+bonus*100 dungeonrec.stats(21)=dungeonrec.stats(21)-1 ' decrement dungeon level coins If dungeonrec.stats(21)=0 Then ' player has taken last coin If dungeonrec.stats(22)=0 Then dungeonrec.stats(22)=1 ' set all dungeon level coins flag d$="coins" Gosub Treasure.Bonus ' bonus for last coin Endif Endif Return ' exit routine ' find coin pile Find.Coin.Pile: dungeonrec.dat(xco,yco)=46 ' reset cell to dungeon dot Gosub Coin.Pile ' get coins to add to gold dungeonrec.stats(11)=dungeonrec.stats(11)-1 ' decrement dungeon level gold If dungeonrec.stats(11)=0 Then ' player has the last gold If dungeonrec.stats(12)=0 Then dungeonrec.stats(12)=1 ' set all dungeon level gold flag d$="coin piles" Gosub Treasure.Bonus ' bonus for all gold Endif Endif Return ' exit routine ' calculate coin pile Coin.Pile: ' select coin type ran!=Rnd ' based on percentage If ran!>.85 Then bonus=8 ' multiplier b$="platinum" ' coin name Else If ran!>.75 Then bonus=5 ' multiplier b$="gold" ' coin name Else If ran!>.50 Then bonus=3 ' multiplier b$="silver" ' coin name Else bonus=2 ' multiplier b$="copper" ' coin name Endif Endif Endif Color 14 ' ansi color a$="You find some "+b$+" coins!" ' make display message Gosub Display.Message ' output message ' calculate increment to players gold by bonus multiplier temp#=Rnd*dlvl# temp#=temp#+Rnd*userrec.stats1(2)+10 temp#=Int(temp#*bonus*10) userrec.stats1(5)=userrec.stats1(5)+temp# Return ' exit routine ' find scroll Scroll: dungeonrec.dat(xco,yco)=46 ' reset cell to dungeon dot Color 14 ' ansi color a$="You find a scroll!(5 to take or 9 to ignore)" Gosub Display.Message ' output message Do ' get a keystroke Gosub Get.Keystroke Loop Until x=5 Or x=9 ' presses enter/5 to take scroll If x=5 Then rand=Int(Rnd*40+1) ' select a random spell from 40 Restore Spell.Data ' restore data pointer to spell data userrec.spell(rand)=1 ' set spell flag For i=1 To rand ' read spell Read b$,c$ ' spell chant, spell name Next Color 11 ' display spell chant in quotes a$="The scroll reads "+Chr$(34)+b$+Chr$(34) Gosub Display.Message ' output message Endif ' no action for ignore/9 dungeonrec.stats(7)=dungeonrec.stats(7)-1 ' decrement dungeon level scroll If dungeonrec.stats(7)=0 Then ' player has the last scroll If dungeonrec.stats(8)=0 Then dungeonrec.stats(8)=1 ' set all dungeon level scroll flag d$="scrolls" Gosub Treasure.Bonus ' bonus for all scrolls Endif Endif Return ' exit routine ' enter chant of spell to cast Cast.Chant: Color 12 ' ansi color a$="Type in spell chant:" ' make display message prompt Gosub Display.Message ' output message Color 15 ' ansi color ' loop to retrieve spell$ character by character. ' backspace, enter, and characters A to Z are accepted, ' otherwise a beep, or beep for backspace before column one, ' or beep for enter with no characters input. Maximum 55 characters. spell$="" ' clear spell$ Locate 25,22,1 ' position cursor Do x$="" ' get keystroke While x$="" ' wait for input x$=Inkey$ ' get keystroke Wend ' end wait Select Case x$ Case Chr$(13) ' enter pressed Exit Do Case Chr$(8) ' backspace If Len(Spell$)=0 Then Beep ' warning signal Else Locate Csrlin,Pos(0)-1,1 ' position cursor Print " "; Locate Csrlin,Pos(0)-1,1 ' position cursor spell$=Left$(spell$,Len(spell$)-1) ' truncate input string one character Endif Case "a" To "z", "A" To "Z", " " 'check valid character If Len(spell$)=55 Then ' verify length of string Beep ' warning signal Else spell$=spell$+x$ ' append to spell$ Print x$; Endif End Select Loop spell$=Lcase$(spell$) Color 7 ' ansi color Restore Spell.Data ' restore data pointer to spell data Gosub Pause.Second ' wait For i=1 To 40 ' read 40 spell data items Read a$, c$ ' read chant, spell name If a$=spell$ Then ' compare input string to spell chant spn=Int((i-1)/10)+1 ' calculate spell type 1 to 4 sp=i-(spn-1)*10 ' calculate spell number 1 to 10 Select Case spn ' select spell type Case 1 ' spell type 1 Gosub Cast.Spell.Type1 Case 2 ' spell type 2 Gosub Cast.Spell.Type2 Case 3 ' spell type 3 Gosub Cast.Spell.Type3 Case 4 ' spell type 4 Gosub Cast.Spell.Type4 End Select Return ' exit routine Endif Next Color 13 ' ansi color a$="That spell chant does nothing!" ' make display message Gosub Display.Message ' output message Return ' exit routine ' use an item of magic from inventory Use.Item: Color 14 ' ansi color a$="Enter item(1=wand, 3=potion, 5=staff, 7=ring, or 9 to quit)" Gosub Display.Message ' output message Do ' get a keystroke Gosub Get.Keystroke Loop Until x=1 Or x=3 Or x=5 Or x=7 Or x=9 ' presses 1, 3, 5, 7, to use inventory item ' use a wand from inventory If x=1 Then Color 12 ' ansi color a$="Type in wand letter(A-J):" ' make display message prompt Gosub Display.Message ' output message Locate 25,28,1 ' position cursor Do ' loop until alphaletter A to J is pressed x$="" ' get keystroke While x$="" ' wait for input x$=Inkey$ ' get keystroke Wend ' end wait x$=Ucase$(x$) If x$>="A" And x$<="J" Then Exit Do Endif Loop Color 7 ' ansi color i=asc(x$)-64 ' calculate wand number 1 to 10 Gosub Use.Wand ' use selected wand Return ' exit routine Endif ' use a potion from inventory If x=3 Then Color 12 ' ansi color a$="Type in potion letter(K-T):" ' make display message prompt Gosub Display.Message ' output message Locate 25,30,1 ' position cursor Do ' loop until alphaletter K to T is pressed x$="" ' get keystroke While x$="" ' wait for input x$=Inkey$ ' get keystroke Wend ' end wait x$=Ucase$(x$) If x$>="K" And x$<="T" Then Exit Do Endif Loop Color 7 ' ansi color i=asc(x$)-74 ' calculate potion number 1 to 10 Gosub Use.Potion ' use selected potion Return ' exit routine Endif ' use a staff from inventory If x=5 Then Color 12 ' ansi color a$="Type in staff letter(Q-Z):" ' make display message prompt Gosub Display.Message ' output message Locate 25,28,0 ' position cursor Do ' loop until alphaletter Q to Z is pressed x$="" ' get keystroke While x$="" ' wait for input x$=Inkey$ ' get keystroke Wend ' end wait x$=Ucase$(x$) If x$>="Q" And x$<="Z" Then Exit Do Endif Loop Color 7 ' ansi color i=asc(x$)-80 ' calculate staff number 1 to 10 Gosub Use.Staff ' use selected staff Return ' exit routine Endif ' use a ring from inventory If x=7 Then Color 12 ' ansi color a$="Type in ring letter(Q-Z):" ' make display message prompt Gosub Display.Message ' output message Locate 25,28,1 ' position cursor Do ' loop until alphaletter Q to Z is pressed x$="" ' get keystroke While x$="" ' wait for input x$=Inkey$ ' get keystroke Wend ' end wait x$=Ucase$(x$) If x$>="Q" And x$<="Z" Then Exit Do Endif Loop Color 7 ' ansi color i=asc(x$)-80 ' calculate ring number 1 to 10 Gosub Use.Ring ' use selected ring Return ' exit routine Endif Return ' exit routine ' use selected wand Use.Wand: Restore Wand.Data ' restore data pointer to wand data For j=1 To i ' read up to selected wand in variable i Read b$, x ' wand name, spell number Next ' check for wand charges If userrec.wand(i)=0 Then ' no charges left Color 13 ' ansi color a$="You do not have a "+b$+" wand!" ' make display message Gosub Display.Message ' output message Return ' exit routine Endif Color 13 ' ansi color a$="You use a "+b$+" wand!" ' for wand selected userrec.wand(i)=userrec.wand(i)-1 ' decrement wand charges If userrec.wand(i)=0 Then ' verify wand charges a$=a$+" It vanished!" ' make display message, empty wand Endif Gosub Display.Message ' output message Gosub Pause.Second ' wait spn=Int((x-1)/10)+1 ' calculate spell type from data in variable x sp=x-(spn-1)*10 ' calculate spell number from data in variable x Select Case spn ' select spell type Case 1 ' spell type 1 Gosub Cast.Spell.Type1 Case 2 ' spell type 2 Gosub Cast.Spell.Type2 Case 3 ' spell type 3 Gosub Cast.Spell.Type3 Case 4 ' spell type 4 Gosub Cast.Spell.Type4 End Select Return ' exit routine ' use a selected potion Use.Potion: Restore Potion.Data ' restore data pointer to potion data For j=1 To i ' read up to selected potion in variable i Read b$, x ' potion name, spell number Next ' check for potion charges If userrec.potion(i)=0 Then ' no charges left Color 13 ' ansi color a$="You do not have a "+b$+" potion!" ' make display message Gosub Display.Message ' output message Return ' exit routine Endif Color 13 ' ansi color a$="You drink a "+b$+" potion!" ' for potion selected userrec.potion(i)=userrec.potion(i)-1 ' decrement potion charges If userrec.potion(i)=0 Then ' verify potion charges a$=a$+" It vanished!" ' make display message, for empty potion Endif Gosub Display.Message ' output message Gosub Pause.Second ' wait spn=Int((x-1)/10)+1 ' calculate spell type from variable x sp=x-(spn-1)*10 ' calculate spell number from variable x Select Case spn ' select spell type Case 1 ' spell type 1 Gosub Cast.Spell.Type1 Case 2 ' spell type 2 Gosub Cast.Spell.Type2 Case 3 ' spell type 3 Gosub Cast.Spell.Type3 Case 4 ' spell type 4 Gosub Cast.Spell.Type4 End Select Return ' exit routine ' use selected staff Use.Staff: Restore Staff.Data ' restore data pointer to staff data For j=1 To i ' read up to selected staff in variable i Read b$, x ' staff name, spell number Next ' check for staff charges If userrec.staff(i)=0 Then ' no charges left Color 13 ' ansi color a$="You do not have a "+b$+" staff!" ' make display message Gosub Display.Message ' output message Return ' exit routine Endif Color 13 ' ansi color a$="You use a "+b$+" staff!" ' for selected staff userrec.staff(i)=userrec.staff(i)-1 ' decrement staff charges If userrec.staff(i)=0 Then ' verify staff charges a$=a$+" It vanished!" ' make display message, for empty staff Endif Gosub Display.Message ' output message Gosub Pause.Second ' wait spn=Int((x-1)/10)+1 ' calculate spell type from variable x sp=x-(spn-1)*10 ' calculate spell number from variable x Select Case spn ' select spell type Case 1 ' spell type 1 Gosub Cast.Spell.Type1 Case 2 ' spell type 2 Gosub Cast.Spell.Type2 Case 3 ' spell type 3 Gosub Cast.Spell.Type3 Case 4 ' spell type 4 Gosub Cast.Spell.Type4 End Select Return ' exit routine ' use selected ring Use.Ring: Restore Ring.Data ' restore data pointer to ring data For j=1 To i ' read up to selected ring in variable i Read b$, x ' staff name, spell number Next ' check for ring charges If userrec.ring(i)=0 Then ' no charges left Color 13 ' ansi color a$="You do not have a "+b$+" ring!" ' make display message Gosub Display.Message ' output message Return ' exit routine Endif Color 13 ' ansi color a$="You use a "+b$+" ring!" ' for selected ring userrec.ring(i)=userrec.ring(i)-1 ' decrement ring charges If userrec.ring(i)=0 Then ' verify ring charges a$=a$+" It vanished!" ' make display message, for empty ring Endif Gosub Display.Message ' output message Gosub Pause.Second ' wait spn=Int((x-1)/10)+1 ' calculate spell type from variable x sp=x-(spn-1)*10 ' calculate spell number from variable x Select Case spn ' select spell type Case 1 ' spell type 1 Gosub Cast.Spell.Type1 Case 2 ' spell type 2 Gosub Cast.Spell.Type2 Case 3 ' spell type 3 Gosub Cast.Spell.Type3 Case 4 ' spell type 4 Gosub Cast.Spell.Type4 End Select Return ' exit routine ' find a wand Wand: dungeonrec.dat(xco,yco)=46 ' reset dungeon cell to dungeon dot Color 14 ' ansi color a$="You find a wand!(5 to take or 9 to ignore)" Gosub Display.Message ' output message Do ' get a keystroke Gosub Get.Keystroke Loop Until x=5 Or x=9 ' presses enter/5 to take wand If x=5 Then rand=Int(Rnd*10+1) ' select a random wand from 10 Restore Wand.Data ' restore data pointer to wand data For i=1 To rand ' read up to random wand number Read b$, x ' wand name, spell number Next a=userrec.wand(rand) ' get wand array number If a Then ' if wand exists in inventory Color 10 ' ansi color a$="You already have a wand of "+b$+"!" ' make display message Else Color 13 ' ansi color a$="You now have a wand of "+b$+"!" ' make display message userrec.wand(rand)=Int(Rnd*3+1) ' set wand array number to random charges Endif Gosub Display.Message ' output message Gosub Pause.Second ' wait Endif ' determine existing wands in dungeon level dungeonrec.stats(25)=dungeonrec.stats(25)-1 ' decrement dungeon level wand If dungeonrec.stats(25)=0 Then ' player has taken last wand If dungeonrec.stats(26)=0 Then dungeonrec.stats(26)=1 ' set all dungeon level wand flag d$="wands" Gosub Treasure.Bonus ' bonus for last wand Endif Endif Return ' exit routine ' find a potion Potion: dungeonrec.dat(xco,yco)=46 ' reset dungeon cell to dungeno dot Color 14 ' ansi color a$="You find a potion!(5 to take or 9 to ignore)" Gosub Display.Message ' output message Do ' get a keystroke Gosub Get.Keystroke Loop Until x=5 Or x=9 ' presses enter/5 to take potion If x=5 Then rand=Int(Rnd*10+1) ' select a random potion from 10 Restore Potion.Data ' restore data pointer to potion data For i=1 To rand ' read up to random potion number Read b$, x ' potion name, spell number Next a=userrec.potion(rand) ' get potion array number If a Then ' if potion exists in inventory Color 10 ' ansi color a$="You already have a potion of "+b$+"!" ' make display message Else Color 13 ' ansi color a$="You now have a potion of "+b$+"!" ' make display message userrec.potion(rand)=Int(Rnd*3+2) ' set potion array number random charges Endif Gosub Display.Message ' output message Gosub Pause.Second ' wait Endif ' determine existing potions in dungeon level dungeonrec.stats(27)=dungeonrec.stats(27)-1 ' decrement dungeon level potion If dungeonrec.stats(27)=0 Then ' player has take last potion If dungeonrec.stats(28)=0 Then dungeonrec.stats(28)=1 ' set all dungeon level potion flag d$="potions" Gosub Treasure.Bonus ' bonus for last potion Endif Endif Return ' exit routine ' find a staff Staff: dungeonrec.dat(xco,yco)=46 ' reset dungeon cell to dungeon dot Color 14 ' ansi color a$="You find a staff!(5 to take or 9 to ignore)" Gosub Display.Message ' output message Do ' get a keystroke Gosub Get.Keystroke Loop Until x=5 Or x=9 ' presses enter/5 to take staff If x=5 Then rand=Int(Rnd*10+1) ' select a random staff from 10 Restore Staff.Data ' restore data pointer to staff data For i=1 To rand ' read up to random staff number Read b$, x ' staff name, spell number Next a=userrec.staff(rand) ' get staff array number If a Then ' if staff exists in inventory Color 10 ' ansi color a$="You already have a staff of "+b$+"!" ' make display message Else Color 13 ' ansi color a$="You now have a staff of "+b$+"!" ' make display message userrec.staff(rand)=Int(Rnd*3+2) ' set staff array number random charges Endif Gosub Display.Message ' output message Gosub Pause.Second ' wait Endif ' determine existing staffs in dungeon level dungeonrec.stats(29)=dungeonrec.stats(29)-1 ' decrement dungeon level staff If dungeonrec.stats(29)=0 Then ' player has taken last staff If dungeonrec.stats(30)=0 Then dungeonrec.stats(30)=1 ' set all dungeon level staff flag d$="staffs" Gosub Treasure.Bonus ' bonus for last staff Endif Endif Return ' exit routine ' find a ring Ring: dungeonrec.dat(xco,yco)=46 ' reset dungeon cell to dungeon dot Color 14 ' ansi color a$="You find a ring!(5 to take or 9 to ignore)" Gosub Display.Message ' output message Do ' get a keystroke Gosub Get.Keystroke Loop Until x=5 Or x=9 ' presses enter/5 to take ring If x=5 Then rand=Int(Rnd*10+1) ' select a random ring from 10 Restore Ring.Data ' restore data pointer to ring data For i=1 To rand ' read up to random ring number Read b$, x ' ring name, spell number Next a=userrec.ring(rand) ' get ring array number If a Then ' if ring exists in inventory Color 10 ' ansi color a$="You already have a ring of "+b$+"!" ' make display message Else Color 13 ' ansi color a$="You now have a ring of "+b$+"!" ' make display message userrec.ring(rand)=Int(Rnd*3+2) ' set ring array number random charges Endif Gosub Display.Message ' output message Gosub Pause.Second ' wait Endif ' determine existing rings in dungeon level dungeonrec.stats(31)=dungeonrec.stats(31)-1 ' decrement dungeon level ring If dungeonrec.stats(31)=0 Then ' player has taken last ring If dungeonrec.stats(32)=0 Then dungeonrec.stats(32)=1 ' set all dungeon level ring flag d$="rings" Gosub Treasure.Bonus ' bonus for last ring Endif Endif Return ' exit routine ' calculate path for player to evade monster in nearby cell Evade.Monster: Do ' loop until empty cell to move player For k=1 To Int(Rnd*2+2) ' move player random times c=0 ' loop counter Do ' find empty cell c=c+1 ' increment counter If c>10 Then ' avoid infinite loop Exit For ' exit routine Endif cxco=xco ' store temporary x-coordinate cyco=yco ' store temporary y-coordinate Gosub Get.Random.Direction ' get valid random direction If Coor.Direction Then ' returned valid random direction If dungeonrec.dat(xco+xo,yco+yo)=46 Then ' empty dungeon cell Exit Do ' found empty cell at random direction Endif Endif Loop ' move to selected cell xco=xco+xo ' increment players x coordinate yco=yco+yo ' increment players y coordinate Gosub Update.Player ' update nearby cell actions Next ' get next evade move If dungeonrec.dat(xco,yco)=46 Then ' move to an dungeon dot Exit Do ' end move player Endif Loop Return ' exit routine ' player attacks all nearby monsters at all coordinates Attack.Nearby.Monsters: For mxco=xco-1 To xco+1 For myco=yco-1 To yco+1 If mxco>1 And mxco<23 Then If myco>1 And myco<79 Then Gosub Attack.Monster Endif Endif Next Next Return ' player attacks a nearby monster at coordinates mxco, myco Attack.Monster: Gosub Update.Counters ' reset any increment counters to do with monsters f=0 ' attack monster flag For mn=1 To 8 ' loop through each of eight monsters in surrounding cells If monsters(mn,1)=mxco And monsters(mn,2)=myco Then ' select monster coor. f=1 Exit For Endif Next If f=0 Then ' no monster found Return ' exit routine Endif x=userrec.stats2(5)+userrec.stats2(12) ' dexterity plus boots y=Int(Rnd*(20+monsters(mn,3))) ' miss monster equation If y>x Then ' misses monster Color 12 ' ansi color a$="You missed!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Return ' exit routine Endif ran!=Rnd ' calculate bonus to hit monster by random percentage If ran!>.96 Then ' random hit one, bonus=4 ' high hit bonus Else If ran!>.91 Then ' random hit two, bonus=3 ' normal hit bonus Else If ran!>.86 Then ' random hit three bonus=2 ' low hit bonus Else bonus=1 ' no hit bonus Endif Endif Endif ' calculate hits on monster hits#=Rnd*(userrec.stats2(1)+stp)+userrec.stats1(2)/2 hits#=hits#*bonus+userrec.stats2(7)+dlvl# hits#=int(hits#) If hits#<=0 Then ' zero hits misses Color 12 ' ansi color a$="You missed!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Return ' exit routine Endif Color 14 ' ansi color ' make display message with monster name and hits on monster a$="You hit the "+monstername(monsters(mn,6))+" for"+Str$(hits#)+" hits!" If slp Then ' sleep flag a$=a$+" It's helpless!" Endif Gosub Display.Message ' output message Gosub Pause.Second ' wait monsters(mn,4)=monsters(mn,4)-hits# ' decrement monsters hits If monsters(mn,4)>0 Then ' monsters hits below zero, monster died, Return ' exit routine Endif ex#=monsters(mn,5) ' get experience Gosub Update.Stats ' add to players statistics dungeonrec.dat(mxco,myco)=46 ' reset dungeon cell to dungeon dot monsters(mn,1)=0 ' clear monster x-coordinate monsters(mn,2)=0 ' clear monster y=coordinate Color 15 ' ansi color Locate mxco,myco,0 ' position cursor Print "$"; ' make $ at dead monster cell ' select coin type ran!=Rnd ' based on percentage If ran!>.85 Then bonus=8 ' multiplier b$="platinum" ' coin name Else If ran!>.75 Then bonus=5 ' multiplier b$="gold" ' coin name Else If ran!>.50 Then bonus=3 ' multiplier b$="silver" ' coin name Else bonus=2 ' multiplier b$="copper" ' coin name Endif Endif Endif ' make display message with monster killed and coins found Color 14 ' ansi color a$="You killed the "+monstername(monsters(mn,6))+"!" a$=a$+" On it is some "+b$+"!(5 to take or 9 to ignore)" Gosub Display.Message ' output message Do ' get a keystroke Gosub Get.Keystroke Loop Until x=5 Or x=9 ' presses enter/5 to take coins If x=5 Then temp#=Rnd*monsters(mn,4) temp#=temp#+Rnd*monsters(mn,5)+10 temp#=Int(temp#*bonus*10) userrec.stats1(5)=userrec.stats1(5)+temp# Endif If Rnd>.5 Then ' 50/50 find some gems Color 15 ' ansi color Locate mxco,myco,0 ' position cursor Print "*"; ' select gem type ran!=Rnd ' based on percentage If ran!>.85 Then bonus=8 ' multiplier b$="diamonds" ' gem name Else If ran!>.75 Then bonus=5 ' multiplier b$="emeralds" ' gem name Else If ran!>.50 Then bonus=3 ' multiplier b$="saphires" ' gem name Else bonus=2' multiplier b$="rubies" ' gem name Endif Endif Endif Color 14 ' ansi color ' make display message with gem type found a$="You find some "+b$+"!(5 to take or 9 to ignore)" Gosub Display.Message ' output message Do ' get a keystroke Gosub Get.Keystroke Loop Until x=5 Or x=9 ' presses enter/5 to take gems If x=5 Then temp#=Rnd*monsters(mn,4) temp#=temp#+Rnd*monsters(mn,5)+10 temp#=Int(temp#*bonus) userrec.stats1(5)=userrec.stats1(5)+temp# Endif Endif If Rnd>.75 Then ' 3/4 percent chance for chest Color 15 ' ansi color Locate mxco,myco,0 ' position cursor Print Chr$(254); ' chest symbol Gosub Chest ' open the chest Endif Color 7 ' ansi color Locate mxco,myco,0 ' position cursor Print "."; ' display dungeon dot dungeonrec.stats(6)=dungeonrec.stats(6)-1 ' decrement dungeon level monsters If dungeonrec.stats(6)=0 Then ' last monster If dungeonrec.stats(5)=0 Then ' all dungeon level monsters flags dungeonrec.stats(5)=1 ' set all dungeon level monsters flag ' calculate experience gained for last monster killed ex#=(Rnd*dlvl#*2+1)*userrec.stats1(2)^2/2 ex#=ex#+dlvl#*2+Rnd*userrec.stats1(2)*50 ex#=Int(ex#) Color 14 ' ansi color a$="You killed all the monsters on this level! You gain" a$=a$+Str$(ex#)+" experience!" Gosub Display.Message ' output message Gosub Update.Stats ' add to players statistics Gosub Pause.Second ' wait Endif Endif Return ' exit routine ' reset/increment any counters Update.Counters: shpc=shpc-1 ' decrement shield counter If shpc<0 Then ' check shield counter shp=0 ' reset shield amount shpc=0 ' reset shield counter Endif mhpmc=mhpmc-1 'decrement monster hit point minus counter If mhpmc<0 Then ' check monster hit point minus counter mhpm=0 ' reset monster hit point minus amount mhpmc=0 ' reset monster hit point minus counter Endif slpc=slpc-1 ' decrement sleep counter If slpc<0 Then ' check sleep counter slp=0 ' reset sleep flag slpc=0 ' reset sleep counter Endif stpc=stpc-1 ' decrement strength counter If stpc<0 Then ' check strength counter stp=0 ' reset strength amount stpc=0 ' reset strength counter Endif pwc=pwc-1 ' decrement pass monsters counter If pwc<0 Then ' check pass monsters counter pw=0 ' reset pass monsters flag pwc=0 ' reset pass monsters counter Endif If pw=1 Then ' check pass monsters flag slp=1 ' set sleep flag slpc=1 ' set sleep counter Endif Return ' exit routine ' find a trap Trap: dungeonrec.dat(xco,yco)=46 ' reset cell to dungeon dot Color 31 ' ansi color Locate xco,yco,0 ' position cursor Print "^"; ' display a blinking trap where the character X is Color 11 ' ansi color a$="You triggered a trap! " ' message to display in hit.player routine mhp#=0 ' reset monster hit points to zero, then Gosub Hit.Player ' hit player will calculate hits from trap dungeonrec.stats(9)=dungeonrec.stats(9)-1 ' decrement dungeon level trap counter If dungeonrec.stats(9)=0 Then ' player has triggered the last trap If dungeonrec.stats(10)=0 Then dungeonrec.stats(10)=1 ' set all dungeon level trap flag Endif Endif Return ' exit routine ' find a pit Pit: dungeonrec.dat(xco,yco)=46 ' reset cell to dungeon dot Color 31 ' ansi color Locate xco,yco,0 ' position cursor Print "o"; ' display a blinking pit where the character X is Color 11 ' ansi color a$="You fell in a pit! " ' message to display in hit.player routine mhp#=0 ' reset monster hit points to zero, then Gosub Hit.Player ' hit player will calculate hits from pit dungeonrec.stats(13)=dungeonrec.stats(13)-1 ' decrement dungeon level pit counter If dungeonrec.stats(13)=0 Then ' player has fallen in the last pit If dungeonrec.stats(14)=0 Then dungeonrec.stats(14)=1 ' set all dungeon level pit flag Endif Endif Return ' exit routine ' open located chest Find.Chest: dungeonrec.dat(xco,yco)=46 ' reset cell with dungeon dot Gosub Chest dungeonrec.stats(23)=dungeonrec.stats(23)-1 ' decrement dungeon level chest If dungeonrec.stats(23)=0 Then ' player has opened last chest If dungeonrec.stats(24)=0 Then dungeonrec.stats(24)=1 ' set all dungeon level chest flag d$="chests" Gosub Treasure.Bonus ' bonus for last chest Endif Endif Return ' exit routine ' open any chest Chest: Color 14 ' ansi color a$="You find a chest!(5 to open or 9 to ignore)" Gosub Display.Message ' output message Do ' get a keystroke Gosub Get.Keystroke Loop Until x=5 Or x=9 ' presses enter/5 to open chest If x=5 Then number=Int(Rnd*4+1) ' select random number of chest contents For i=1 To number ' loop through number of contents choice=Int(Rnd*6+1) ' select random treasure in chest Select Case choice ' get treasure name Case 1 ' type 1 b$="a weapon" Case 2 ' type 2 b$="a shield" Case 3 ' type 3 b$="some armor" Case 4 ' type 4 b$="a cloak" Case 5 ' type 5 b$="a helmet" Case 6 ' type 6 b$="some boots" End Select Color 13 ' ansi color a$="In it you find "+b$+"!(5 to take or 9 to ignore)" Gosub Display.Message ' output message Do ' get s keystroke Gosub Get.Keystroke Loop Until x=5 Or x=9 ' presses enter/5 to take item If x=5 Then ' calculate bonus of item selected bonus=Int(Rnd*dlvl#*2+1) If bonus>99 Then ' restrict bonus plus of item to 99 bonus=99 ' reset to 99 if greater Endif ' select the item, computing variable 'a' equal to; ' zero if the bonus is greater than existing item in inventory, ' and setting the inventory to the bonus, or ' true if the existing item in inventory is greater than the bonus, ' and setting the variable max to the plus of the inventory item. Select Case choice Case 1 ' type weapon If bonus>userrec.stats2(7) Then ' is chest bonus greater? a=0 ' yes, userrec.stats2(7)=bonus ' increase weapon plus; Else a=-1 ' no, max=userrec.stats2(7) ' set max to existing weapon plus. Endif Case 2 ' type shield If bonus>userrec.stats2(8) Then ' is chest bonus greater? a=0 ' yes, userrec.stats2(8)=bonus ' increase shield plus; Else a=-1 ' no, max=userrec.stats2(8) ' set max to existing shield plus. Endif Case 3 ' type armor If bonus>userrec.stats2(9) Then ' is chest bonus greater? a=0 ' yes, userrec.stats2(9)=bonus ' increase armor plus; Else a=-1 ' no, max=userrec.stats2(9) ' set max to existing armor plus. Endif Case 4 ' type cloak If bonus>userrec.stats2(10) Then ' is chest bonus greater? a=0 ' yes, userrec.stats2(10)=bonus ' increase cloak plus; Else a=-1 ' no, max=userrec.stats2(10) ' set max to existing cloak plus. Endif Case 5 ' type helmet If bonus>userrec.stats2(11) Then ' is chest bonus greater? a=0 ' yes, userrec.stats2(11)=bonus ' increase helmet plus; Else a=-1 ' no, max=userrec.stats2(11) ' set max to existing helmet plus. Endif Case 6 ' type boot If bonus>userrec.stats2(12) Then ' is chest bonus greater? a=0 ' yes, userrec.stats2(12)=bonus ' increase boot plus; Else a=-1 ' no, max=userrec.stats2(12) ' set max to existing boot plus. Endif End Select If a Then ' player has the item of greater plus already Color 10 ' ansi color ' make display message for already in inventory a$="You already have "+b$+"(+"+Mid$(Str$(max),2)+")!" Else ' otherwise Color 13 ' ansi color ' make display message with increased plus a$="You now have "+b$+"(+"+Mid$(Str$(bonus),2)+")!" Endif Gosub Display.Message ' output message Gosub Pause.Second ' wait Endif Next If Rnd>.99 Then ' 1 percent chance of chest containing a globe of power If dungeonrec.stats(1)=0 Then ' if this dungeon level has not had one yet If userrec.stats2(17)=0 Then ' and if the player does not have a globe dungeonrec.stats(1)=1 ' set dungeon level globe flag userrec.stats2(17)=1 ' set player globe flag For i=1 to 10 ' loop through globe array userrec.globe(i)=0 ' set usage flag for each Next ' globe power to zero. Color 31 ' ansi color a$="In it you find The Globe of Power!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Color 7 ' ansi color Endif Endif Endif Endif Return ' exit routine ' use a power of the globe Use.Globe: If userrec.stats2(17)=0 Then ' check if player has the globe Color 13 ' ansi color a$="You do not have The Globe of Power!" ' make display message Gosub Display.Message ' output message Return ' exit routine Endif If userrec.globe(i)=1 Then ' if globe power in variable i has been used, Color 13 ' ansi color a$="This Globe Power is depleted!" ' make display message Gosub Display.Message ' output message Return ' exit routine Endif userrec.globe(i)=1 ' set globe power variable i flag to used Select Case i ' select globe power variable i 1 to 10 Case 1 ' replenish level Color 13 ' ansi color a$="The dungeon becomes replenished!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Gosub Zero.Dungeon ' first remove all dungeon treasure, Gosub Replenish.Dungeon ' then replenish dungeon level treasure Case 2 ' down 10 levels Gosub Store.Dungeon.Level ' record the dungeon statistics and screen dlvl#=dlvl#+10 ' increment players dungeon level counter ' check if player has entered a dungeon level lower than his last recorded If dlvl#>userrec.stats1(1) Then ' if lower, userrec.stats1(1)=dlvl# ' set players maximum dungeon level to current level Endif Gosub Next.Dungeon.Level ' load dungeon level statistics Gosub Cell.Action ' compute nearby cells Case 3 ' up 10 levels Gosub Store.Dungeon.Level ' record the dungeon statistics and screen For dt=1 to 10 ' count up 10 levels Gosub Decrement.Dungeon.Level ' subtract one from dungeon level variable If dlvl#=0 Then ' exited the dungeon Return ' exit routine Endif Next Gosub Next.Dungeon.Level ' load dungeon level statistics Gosub Cell.Action ' compute nearby cells Case 4 ' collect all Color 13 ' ansi color a$="You now have all treasure!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait For j=1 to 10 ' set all inventory userrec.wand(j)=Int(Rnd*3+2) ' charges randomly userrec.potion(j)=Int(Rnd*3+2) userrec.staff(j)=Int(Rnd*3+2) userrec.ring(j)=Int(Rnd*3+2) Next Case 5 ' use all wands gdc=0 ' reset extended monster cell death counter For j=1 to 10 ' add up all wand charges gdc=gdc+userrec.wand(j) ' to increment extended monster cell death counter userrec.wand(j)=0 ' reset wands charges to zero Next If gdc>0 Then ' if any charges added, gd=1 ' set extended monster cell death flag Color 13 ' ansi color a$="You use all wands! They vanished!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Gosub Cell.Monster.Attack ' all nearby monsters die Else gd=0 ' reset extended monster cell death flag Color 13 ' ansi color a$="You have no wands!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Endif Case 6 ' use all potions gdc=0 ' reset extended monster cell death counter For j=1 to 10 ' add up all potion charges gdc=gdc+userrec.potion(j) ' to increment extended monster cell death counter userrec.potion(j)=0 ' reset potion charges to zero Next If gdc>0 Then ' if any charges added, gd=1 ' set extended monster cell death flag Color 13 ' ansi color a$="You use all potions! They vanished!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Gosub Cell.Monster.Attack ' all nearby monsters die Else gd=0 ' set extended monster cell death flag Color 13 ' ansi color a$="You have no potions!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Endif Case 7 ' use all staffs gdc=0 ' reset extended monster cell death counter For j=1 to 10 ' add up all staff charges gdc=gdc+userrec.staff(j) ' to increment extended monster cell death counter userrec.staff(j)=0 ' reset staff charges to zero Next If gdc>0 Then ' if any charges added, gd=1 ' set extended monster cell death flag Color 13 ' ansi color a$="You use all staffs! They vanished!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Gosub Cell.Monster.Attack ' all nearby monsters die Else gd=0 ' reset extended monster cell death flag Color 13 ' ansi color a$="You have no staffs!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Endif Case 8 ' use all rings gdc=0 ' reset extended monster cell death counter For j=1 to 10 ' add up all ring charges gdc=gdc+userrec.ring(j) ' to increment extended monster cell death counter userrec.ring(j)=0 ' reset ring charges to zero Next If gdc>0 Then ' if any charges added, gd=1 ' set extended monster cell death flag Color 13 ' ansi color a$="You use all rings! They vanished!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Gosub Cell.Monster.Attack ' all nearby monsters die Else gd=0 ' reset extended monster cell death flag Color 13 ' ansi color a$="You have no rings!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Endif Case 9 ' trade all k=0 ' set counter to add all inventry charges For j=1 to 10 ' add all k=k+userrec.wand(j) ' wand charges, userrec.wand(j)=0 ' set wands to zero k=k+userrec.potion(j) ' potion charges, userrec.potion(j)=0 ' set potions to zero k=k+userrec.staff(j) ' staff charges, userrec.staff(j)=0 ' set staffs to zero k=k+userrec.ring(j) ' ring charges, userrec.ring(j)=0 ' set to zero Next k=Int(k/6) ' average for increase to each statistic userrec.stats2(1)=userrec.stats2(1)+k ' add average to strength If userrec.stats2(1)>99 Then ' check limit, userrec.stats2(1)=99 ' set to maximum Endif userrec.stats2(2)=userrec.stats2(2)+k ' add average to intelligence If userrec.stats2(2)>99 Then ' check limit, userrec.stats2(2)=99 ' set to maximum Endif userrec.stats2(3)=userrec.stats2(3)+k ' add average to wisdom If userrec.stats2(3)>99 Then ' check limit, userrec.stats2(3)=99 ' set to maximum Endif userrec.stats2(4)=userrec.stats2(4)+k ' add average to constitution If userrec.stats2(4)>99 Then 'check limit, userrec.stats2(4)=99 ' set to maximum Endif userrec.stats2(5)=userrec.stats2(5)+k ' add average to dexterity If userrec.stats2(5)>99 Then ' check to limit, userrec.stats2(5)=99 ' set to maximum Endif userrec.stats2(6)=userrec.stats2(6)+k ' add average to charisma If userrec.stats2(6)>99 Then ' check to limit, userrec.stats2(6)=99 ' set to maximum Endif userrec.stats2(7)=userrec.stats2(7)+k ' add average to weapon If userrec.stats2(7)>99 Then ' check limit, userrec.stats2(7)=99 ' set to maximum Endif userrec.stats2(8)=userrec.stats2(8)+k ' add average to shield If userrec.stats2(8)>99 Then ' check limit, userrec.stats2(8)=99 ' set to maximum Endif userrec.stats2(9)=userrec.stats2(9)+k ' add average to armor If userrec.stats2(9)>99 Then ' check limit, userrec.stats2(9)=99 ' set to maximum Endif userrec.stats2(10)=userrec.stats2(10)+k ' add average to cloak If userrec.stats2(10)>99 Then ' check to limit, userrec.stats2(10)=99 ' set to maximum Endif userrec.stats2(11)=userrec.stats2(11)+k ' add average to helmet If userrec.stats2(11)>99 Then ' check to limit, userrec.stats2(11)=99 ' set to maximum Endif userrec.stats2(12)=userrec.stats2(12)+k ' add average to boots If userrec.stats2(12)>99 Then 'check limit, userrec.stats2(12)=99 ' set to maximum Endif Color 13 ' ansi color a$="You trade all treasure! They vanished!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Gosub Extended.Status.Line Case 10 ' clear level dungeonrec.stats(4)=1 ' set cleared dungeon flag Gosub Dungeon.Worth ' total all dungeon treasure Gosub Zero.Dungeon ' clear all dungeon level treasure Color 13 ' ansi color a$="You now have"+Str$(userrec.stats1(5))+" gold!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait End Select For j=1 to 10 ' loop through globe power usage flag array If userrec.globe(j)=0 Then ' remaining globe power Return ' exit routine Endif Next userrec.stats2(17)=0 ' reset player globe flag Color 13 ' ansi color a$="The Globe of Power is depleted!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait Return ' exit routine ' increase experience and reset players statistics Update.Stats: userrec.stats1(3)=userrec.stats1(3)+ex# ' increase experience If userrec.stats1(2)=99 Then ' check valid player level Return ' exit routine Endif x#=userrec.stats1(2)+6 y#=2^x# If userrec.stats1(3)<y# Then ' check sufficient experience Return ' exit routine Endif x#=userrec.stats1(2) y#=2^x# If userrec.stats1(5)<y# Then ' and gold to reach next level Return ' exit routine Endif userrec.stats1(5)=userrec.stats1(5)-y# ' decrease gold for new level ' increase players maximum hit points by constitution userrec.stats1(6)=userrec.stats1(6)+userrec.stats2(4) userrec.stats1(4)=userrec.stats1(6) ' set players hit points userrec.stats1(2)=userrec.stats1(2)+1 ' increment players level x=userrec.stats1(2)*10 ' set players spell points userrec.stats2(13)=x userrec.stats2(14)=x userrec.stats2(15)=x userrec.stats2(16)=x Return ' exit routine ' display additional players statistics at row 25 Extended.Status.Line: x=0 ' line length counter Locate 25,1,0 ' position cursor ' strength Color 12 ' ansi color Print "STR"; ' display strength x=x+3 ' length of line Color 15 ' ansi color a$=Str$(userrec.stats2(1))+" " ' append strength x=x+Len(a$) ' increment line length Print a$; ' display strength ' intelligence Color 12 ' ansi color Print "INT"; ' display intelligence x=x+3 ' length of line Color 15 ' ansi color a$=Str$(userrec.stats2(2))+" " ' append intelligence x=x+Len(a$) ' increment line length Print a$; ' display intelligence ' wisdom Color 12 ' ansi color Print "WIS"; ' display wisdom x=x+3 ' length of line Color 15 ' ansi color a$=Str$(userrec.stats2(3))+" " ' append wisdom x=x+Len(a$) ' increment line length Print a$; ' display wisdom ' constitution Color 12 ' ansi color Print "CON"; ' display constitution x=x+3 ' length of line Color 15 ' ansi color a$=Str$(userrec.stats2(4))+" " ' append constitution x=x+Len(a$) ' increment line length Print a$; ' display constitution ' dexterity Color 12 ' ansi color Print "DEX"; ' display dexterity x=x+3 ' length of line Color 15 ' ansi color a$=Str$(userrec.stats2(5))+" " ' append dexterity x=x+Len(a$) ' increment line length Print a$; ' display dexterity ' charisma Color 12 ' ansi color Print "CHA"; ' display charisma x=x+3 ' length of line Color 15 ' ansi color a$=Str$(userrec.stats2(6))+" " ' append charisma x=x+Len(a$) ' increment line length Print a$; ' display charisma ' weapon plus Color 14 ' ansi color Print "WE"; ' display weapon plus x=x+2 ' length of line Color 15 ' ansi color a$=Str$(userrec.stats2(7))+" " ' append weapon plus x=x+Len(a$) ' increment length of line Print a$; ' display weapon plus ' shield plus Color 14 ' ansi color Print "SH"; ' display shield plus x=x+2 ' length of line Color 15 ' ansi color a$=Str$(userrec.stats2(8))+" " ' append shield plus x=x+Len(a$) ' increment length of line Print a$; ' display shield plus ' armor plus Color 14 ' ansi color Print "AR"; ' display armor plus x=x+2 ' length of line Color 15 ' ansi color a$=Str$(userrec.stats2(9))+" " ' append armor plus x=x+Len(a$) ' increment length of line Print a$; ' display armor plus ' cloak plus Color 14 ' ansi color Print "CL"; ' display cloak plus x=x+2 ' length of line Color 15 ' ansi color a$=Str$(userrec.stats2(10))+" " ' append cloak plus x=x+Len(a$) ' increment length of line Print a$; ' display cloak plus ' helmet plus Color 14 ' ansi color Print "HE"; ' display helmet plus x=x+2 ' length of line Color 15 ' ansi color a$=Str$(userrec.stats2(11))+" " ' append helmet plus x=x+Len(a$) ' increment length of line Print a$; ' display helmet plus ' boot plus Color 14 ' ansi color Print "BO"; ' display boot plus x=x+2 ' length of line Color 15 ' ansi color a$=Str$(userrec.stats2(12)) ' append boot plus x=x+Len(a$) ' increment length of line Print a$; ' display boot plus If x<80 Then ' compare total length of line Print Space$(79-x); ' append blanks Endif Return ' exit routine ' display message at row 25 Display.Message: Locate 25,1,0 ' position cursor a$=Left$(a$,79) Print a$;Space$(79-Len(a$)); a$="" ' clear message Return ' exit routine ' make players statistics status line at row 24 Status.Line: ' make first half of status line e$="DLVL"+Str$(dlvl#) ' dungeon level e$=e$+" LVL"+Str$(userrec.stats1(2)) ' players level e$=e$+" HP"+Str$(userrec.stats1(4)) ' players hit points e$=e$+" EXP"+Str$(userrec.stats1(3)) ' experience e$=e$+" GOLD"+Str$(userrec.stats1(5)) ' gold e$=e$+" NM"+Str$(dungeonrec.stats(6))+" " ' number of monsters remaining x=Len(e$) ' calculate length of first half of status line ' make second half of status line f$="SP" ' spell numbers For i=13 To 16 ' spell level points left f$=f$+Str$(userrec.stats2(i)) ' append spell level points Next y=Len(f$) ' calculate length of second half of status line ' remake first half of status line with ansi codes Locate 24,1,0 ' position cursor Color 12 ' ansi color Print "DLVL"; ' dungeon level Color 15 ' ansi color Print Str$(dlvl#);" "; Color 12 ' ansi color Print "LVL"; ' players level Color 15 ' ansi color Print Str$(userrec.stats1(2));" "; ' players level Color 14 ' ansi color Print "HP"; ' players hit points Color 15 ' ansi color Print Str$(userrec.stats1(4));" "; ' players hit points Color 14 ' ansi color Print "EXP"; ' experience Color 15 ' ansi color Print Str$(userrec.stats1(3));" "; ' players experience Color 10 ' ansi color Print "GOLD"; ' gold Color 15 ' ansi color Print Str$(userrec.stats1(5));" "; ' players gold Color 10 ' ansi color Print "NM"; ' number of monsters remaining Color 15 ' ansi color Print Str$(dungeonrec.stats(6));" "; ' monsters remaining If (x+y)<80 Then ' if both halfs of status line can be displayed Color 11 ' ansi color Print "SP"; ' spell level points remaining Color 15 ' ansi color For i=13 To 16 ' spell level points left Print Str$(userrec.stats2(i)); ' display spell level points Next Print Space$(79-x-y); ' append blanks Return ' exit routine Endif Print Space$(79-x); ' append blanks Return ' exit routine ' pause after displaying a message Pause.Second: tim!=Timer+.5 ' increase variable half a second beyond timer While Timer<tim! ' loop until timer equals variable Wend Return ' exit routine ' retreives a key entered from the keyboard Get.Keystroke: x=0 Do ' loop until valid key x$="" ' get keystroke While x$="" ' wait for input x$=Inkey$ ' get keystroke Wend ' end wait x=Val(x$) ' convert to numeric variable If x Then ' if key is 1 to 9, Exit Do ' exit routine Endif If x$=Chr$(13) Then ' if key is the enter key, x=5 ' set numeric variable to 5 Exit Do ' exit routine Endif If Len(x$)=2 Then ' extended scan code Select Case Asc(Right$(x$,1)) Case 79 ' end key x=1 ' set numeric variable to 1 Exit Do ' exit routine Case 81 ' page down key x=3 ' set numeric variable to 2 Exit Do ' exit routine Case 76 ' center key (enter) x=5 ' set numeric variable to 5 Exit Do ' exit routine Case 71 ' home key x=7 ' set numeric variable to 7 Exit Do ' exit routine Case 73 ' page up key (ignore) x=9 ' set numeric variable to 9 Exit Do ' exit routine End Select Endif If pwl=1 And Len(x$)=2 Then ' passwall has separate input loop Exit Do Endif Loop Return ' exit routine ' help function/0 key User.List: f$="UTIL.EXE" ' store utility program filename If Dir$(f$)=f$ Then ' verify utility program exists Gosub Store.Dungeon.Level ' store dungeon screen Gosub Put.User.File ' store user record Close ' close all open files Shell f$ ' run utility program Gosub Open.User.File ' reopen user file Gosub Open.Data.File ' reopen data file Gosub Restore.Screen ' redraw dungeon screen Endif ' end verify utility program Return ' exit routine ' help function/0 key Display.Help: Gosub Store.Dungeon.Level ' store dungeon screen f$="HELP.EXE" ' store help program filename If Dir$(f$)=f$ Then ' verify help program exists Shell f$ ' run help program Else ' help program does not exist Gosub Display.Help.Screen ' display default help screen Endif Gosub Restore.Screen ' redraw dungeon screen Return ' exit routine ' display default help screens Display.Help.Screen: Color 14, 1 ' blue background Cls ' clear screen Print Print Print "Cursor Keys Numeric Keypad Dungeon Runes" Print Print "End - fight 1 - fight X - your player" Print "Down - south 2 - south # - monster" Print "Page Down - cast 3 - cast ~ - scroll" Print "Left - west 4 - west $ - gold" Print "Return - accept 5 - accept ";Chr$(254);" - chest" Print "Right - east 6 - east ^ - trap" Print "Home - evade 7 - evade o - pit" Print "Up - north 8 - north * - gems" Print "Page Up - ignore 9 - ignore ! - teleporter" Print "Insert - help 0 - help ? - temple" Print "Delete - status line . - status line > - stairs up" Print "Control-Right - information + - information < - stairs down" Print "Control-PageDown - display chants - - display chants & - coins" Print "Control-Home - trade \ - trade | - wand" Print "Control-End - change level = - change level @ - potion" Print "Control-PageUp - use item ' - use item % - staff" Print "Control-Left - inventory / - inventory ";Chr$(34);" - ring" Print "Shift-Tab - buy inventory ; - buy inventory ";Chr$(176);" - dungeon wall"; Print "Alt-= - user list ` - user list" Gosub Key.Press Color 14, 1 ' blue background Cls ' clear screen Print Space$(10); Print "Spell Level 1 - Normal Spell Level 3 - Shift-" Print Space$(10); Print "F1 - heal F1 - regenerate" Print Space$(10); Print "F2 - protection from evil F2 - forget" Print Space$(10); Print "F3 - magic missile F3 - lightning bolt" Print Space$(10); Print "F4 - shield F4 - phantasmal force" Print Space$(10); Print "F5 - strength F5 - wall of force" Print Space$(10); Print "F6 - sleep F6 - charm monster" Print Space$(10); Print "F7 - locate F7 - continual light" Print Space$(10); Print "F8 - pyrotechnics F8 - passwall" Print Space$(10); Print "F9 - firestorm F9 - demon summon" Print Space$(10); Print "F10 - transmute F10 - doomkill" Print Print Space$(10); Print "Spell Level 2 - Control- Spell Level 4 - Alt-" Print Space$(10); Print "F1 - restoration F1 - resurrection" Print Space$(10); Print "F2 - scare F2 - fear" Print Space$(10); Print "F3 - fireball F3 - disintegrate" Print Space$(10); Print "F4 - obscurement F4 - blade barrier" Print Space$(10); Print "F5 - power shield F5 - enchanted weapon" Print Space$(10); Print "F6 - wall of will F6 - hold monster" Print Space$(10); Print "F7 - light F7 - teleport" Print Space$(10); Print "F8 - levitate F8 - polymorph" Print Space$(10); Print "F9 - monster summon F9 - time stop" Print Space$(10); Print "F10 - finger of death F10 - genocide"; Gosub Key.Press Color 14, 1 ' blue background Cls ' clear screen Print Space$(10); Print "Wands Staffs" Print Space$(10); Print "Alt-A - magic missile Control-A - locate" Print Space$(10); Print "Alt-B - pyrotechnics Control-B - transmute" Print Space$(10); Print "Alt-C - firestorm Control-C - light" Print Space$(10); Print "Alt-D - fireball Control-D - levitate" Print Space$(10); Print "Alt-E - finger of death Control-E - continual light" Print Space$(10); Print "Alt-F - lightning bolt Control-F - passwall" Print Space$(10); Print "Alt-G - doomkill Control-G - fear" Print Space$(10); Print "Alt-H - disintegrate Control-H - enchanted weapon" Print Space$(10); Print "Alt-I - blade barrier Control-I - teleport" Print Space$(10); Print "Alt-J - genocide Control-J - time stop" Print Print Space$(10); Print "Potions Rings" Print Space$(10); Print "Alt-Q - heal Control-Q - sleep" Print Space$(10); Print "Alt-R - protection Control-R - scare" Print Space$(10); Print "Alt-S - shield Control-S - obscurement" Print Space$(10); Print "Alt-T - strength Control-T - monster summon" Print Space$(10); Print "Alt-U - restoration Control-U - forget" Print Space$(10); Print "Alt-V - power shield Control-V - wall of force" Print Space$(10); Print "Alt-W - wall of will Control-W - charm monster" Print Space$(10); Print "Alt-X - regeneration Control-X - demon summon" Print Space$(10); Print "Alt-Y - phantasmal force Control-Y - hold monster" Print Space$(10); Print "Alt-Z - resurrection Control-Z - polymorph"; Gosub Key.Press Color 14, 1 ' blue background Cls ' clear screen Print Print Print Print Print Print Space$(15); Print "The Alt-0 to Alt-9 are the Power Globe keys" Print Print Print Print Space$(15); Print "Alt-0 = clear level Alt-5 = use all wands" Print Space$(15); Print "Alt-1 = replenish level Alt-6 = use all potions" Print Space$(15); Print "Alt-2 = down 10 levels Alt-7 = use all staffs" Print Space$(15); Print "Alt-3 = up 10 levels Alt-8 = use all rings" Print Space$(15); Print "Alt-4 = collect all Alt-9 = trade all" Print Print Space$(10); Print "There is 1% chance of finding the Power Globe in a chest."; Gosub Key.press Color 7 ' ansi color Return ' exit routine ' displays screen of various monster, dungeon level, and player statistics Display.Info: Gosub Store.Dungeon.Level ' store dungeon screen Color 14, 1 ' blue background Cls ' clear screen Gosub Info.Screen ' display screen ' display players combined armors plus Locate 13,25,0 ' position cursor x=0 For i=8 To 11 x=x+userrec.stats2(i) Next Print Str$(x); Locate 14,26,0 ' position cursor Print Str$(userrec.stats2(7)); ' display players weapon plus ' variables store dungeon level minimums, maximums, and averages min.mlvl=0 ' minimum monster level max.mlvl=0 ' monster maximum level tot.mlvl=0 ' monster average level min.hp=0 ' monster minimum hit points max.hp=0 ' monster maximum hit points tot.hp#=0 ' monsters total hit points min.ex=0 ' monsters minimum experience max.ex=0 ' monsters maximum experience tot.ex#=0 ' monsters total experience min.hits=0 ' monsters minimum hits max.hits=0 ' monsters maximum hits tot.hits#=0 ' monsters total hits For i=1 To 10 ' total 10 loops of statistics, calculating minimum and maximum ' random dungeon level monsters level mmlvl=Int(Rnd*dlvl#+dlvl#/2+1) If min.mlvl=0 Then ' set minimum monsters level min.mlvl=mmlvl Endif If mmlvl<min.mlvl Then ' reset minimum monsters level min.mlvl=mmlvl Endif If mmlvl>max.mlvl Then ' reset maximum monsters level max.mlvl=mmlvl Endif tot.mlvl=tot.mlvl+mmlvl ' increase total monster level ' random dungeon level monsters hit points mhp=Int((Rnd*dlvl#*2+1)*mmlvl^2/2+dlvl#*2+Rnd*mmlvl*50) If min.hp=0 Then ' set minimum monsters hit points min.hp=mhp Endif If mhp<min.hp Then ' reset minimum monsters hit points min.hp=mhp Endif If mhp>max.hp Then ' reset maximum monsters hit points max.hp=mhp Endif tot.hp#=tot.hp#+mhp ' increase total monster hit points ' random dungeon level monsters experience mex=Int(mhp/mmlvl)*Int(dlvl#/2+1)+Int(Rnd*mhp) If min.ex=0 Then ' set minimum monsters experience min.ex=mex Endif If mex<min.ex Then ' reset minimum monsters experience min.ex=mex Endif If mex>max.ex Then ' reset maximum monsters experience max.ex=mex Endif tot.ex#=tot.ex#+mex ' increase total monster experience ' random dungeon level monsters hits mhs=0 For j=8 To 11 mhs=mhs+userrec.stats2(j) Next mhits=Int(Rnd*mhp/(mhs+1)+mmlvl) If min.hits=0 Then ' set minimum monsters hits min.hits=mhits Endif If mhits<min.hits Then ' reset minimum monsters hits min.hits=mhits Endif If mhits>max.hits Then ' reset maximum monsters hits max.hits=mhits Endif tot.hits#=tot.hits#+mhits ' increase total monster hits Next Color 12 ' ansi color Locate 20,10,0 ' position cursor Print Str$(min.mlvl); ' display monster minimum level Print String$(15-Len(Str$(min.mlvl)),32); ' pad with spaces Print Str$(min.hp); ' display monster minimum hit points Print String$(15-Len(Str$(min.hp)),32); ' pad with spaces Print Str$(min.ex); ' display monster minimum experience Print String$(15-Len(Str$(min.ex)),32); ' pad with spaces Print Str$(min.hits); ' display monster minimum hits Locate 21,10,0 ' position cursor Print Str$(max.mlvl); ' display monster maximum level Print String$(15-Len(Str$(max.mlvl)),32); ' pad with spaces Print Str$(max.hp); ' display monster maximum hit points Print String$(15-Len(Str$(max.hp)),32); ' pad with spaces Print Str$(max.ex); ' display monster maximum experience Print String$(15-Len(Str$(max.ex)),32); ' pad with spaces Print Str$(max.hits); ' display monster maximum hits i=Int(tot.mlvl/10+.5) ' average monster total level Locate 22,10,0 ' position cursor Print Str$(i); ' display average total Print String$(15-Len(Str$(i)),32); ' pad with spaces i=Int(tot.hp#/10+.5) ' average monster total hit points Print Str$(i); ' display average total Print String$(15-Len(Str$(i)),32); ' pad with spaces i=Int(tot.ex#/10+.5) ' average monster total experience Print Str$(i); ' display average total Print String$(15-Len(Str$(i)),32); ' pad with spaces Print Str$(Int(tot.hits#/10+.5)); ' average monster total hits Color 14 ' ansi color x#=userrec.stats1(2) y#=2^x# Locate 15,37,0 ' position cursor Print Str$(y#); x#=x#+6 y#=2^x# Locate 16,43,0 ' position cursor Print Str$(y#); Gosub Key.Press ' pause for keystroke Gosub Restore.Screen ' redraw dungeon screen Return ' exit routine Info.Screen: Color 14 ' ansi color Print "Mlvl=Int(Rnd*Dlvl+Dlvl/2+1)" Print "Mhp=Int((Rnd*Dlvl*2+1)*Mlvl^2/2+Dlvl*2+Rnd*Mlvl+50)" Print "Exp=Int(Hp/Mlvl)*Int(Dlvl/2+1)+Int(Rnd*Hp)" Print "Mhits=Int(Rnd*(Mhp/Armor)+Mlvl)" Print "Hits=Int(Rnd*Strength+Level/2)*Bonus+Weapon+Dlvl" Print Color 11 ' ansi color Print "Where Mlvl is the monster level, Dlvl is the dungeon level, Mhp is the monster" Print "hit points, Exp is the monsters experience, Armor is your combined armor plus," Print "Weapon is your weapon plus, Strength is your strength, Level is your expertise" Print "level, Hits is the number of points damage your can do to a monster, and Mhits" Print "is the number of points damage a monster can do to you." Color 15 ' ansi color Locate 13,1,0 ' position cursor Print "You now an armor plus of"; Locate 14,1,0 ' position cursor Print "You have a weapon plus of"; Locate 15,1,0 ' position cursor Print "Gold needed to reach the next level:"; Locate 16,1,0 ' position cursor Print "Experience needed to reach the next level:"; Locate 17,1,0 ' position cursor Print "On this dungeon level, monsters have the following statistics:"; Locate 19,10,0 ' position cursor Color 14 ' ansi color Print "Level Hit points Experience Combat hits"; Locate 20,1,0 ' position cursor Print "min."; Locate 21,1,0 ' position cursor Print "max."; Locate 22,1,0 ' position cursor Print "avg."; Return ' exit routine ' randomize random coordinate increments Get.Random.Direction: Select Case Rnd ' random value for selecting nearby x-coordinate cell Case Is<=.3 xo=-1 ' cell to the north Case Is>=.7 xo=1 ' cell to the south Case Else xo=0 ' neither End Select Select Case Rnd ' random value for selecting nearby y-coordinate cell Case Is<=.3 yo=-1 ' cell to the west Case Is>=.7 yo=1 ' cell to the east Case Else yo=0 ' neither End Select Coor.Direction=0 If cxco+xo>1 Then ' x-coordinates boundary If cxco+xo<22 Then ' x-coordinate boundary If cyco+yo>1 Then ' y-coordinate boundary If cyco+yo<76 Then ' y-coordinate boundary If Not (xo=0 And yo=0) Then ' not original xy-coordinate Coor.Direction=-1 Endif Endif Endif Endif Endif Return ' exit routine ' cast spell type 1 Cast.Spell.Type1: userrec.stats2(13)=userrec.stats2(13)-1 ' decrement spell points If userrec.stats2(13)<0 Then ' not enough remaining to cast spell, userrec.stats2(13)=0 ' reset spell point counter to zero Return ' exit routine Endif Gosub Cast.Spell.Message ' display spell name being cast Select Case sp ' select spell number 1 to 10 Case 1 ' heal Gosub Increment.Hits ' update players combat hits Case 2 ' protection mhpm=userrec.stats2(5) ' monster hit point minus amount equal to players dexterity mhpmc=1 ' monster hit point minus counter Case 3 ' magic missile Gosub Pause.Second ' wait bonus=2 ' multiplier Gosub Attack.Nearby.Monsters ' attack nearby monsters Gosub Monster.Attack Gosub Encounter.Cells Case 4 ' shield shp=userrec.stats2(9) ' shield amount equal to players armor shpc=1 ' shield counter Case 5 ' strength stp=userrec.stats2(1) ' strength amount equal to players strength stpc=1 ' strength counter Case 6 ' sleep slp=1 ' sleep flag slpc=1 ' sleep counter Case 7 ' locate Gosub Pause.Second ' wait ' find traps/pits i=0 ' traps flag j=0 ' pits flag ' check surrounding cells If dungeonrec.dat(xco-1,yco)=94 Then ' trap to the north Color 15 ' ansi color Locate xco-1,yco,0 ' position cursor Print "^"; ' display nearby trap symbol i=-1 ' set trap flag Endif If dungeonrec.dat(xco+1,yco)=94 Then ' trap to the south Color 15 ' ansi color Locate xco+1,yco,0 ' position cursor Print "^"; ' display nearby trap i=-1 ' set trap flag Endif If dungeonrec.dat(xco,yco-1)=94 Then ' trap to the west Color 15 ' ansi color Locate xco,yco-1,0 ' position cursor Print "^"; ' display trap i=-1 ' set trap flag Endif If dungeonrec.dat(xco,yco+1)=94 Then ' trap to the east Color 15 ' ansi color Locate xco,yco+1,0 ' position cursor Print "^"; ' display trap i=-1 ' set trap flag Endif If dungeonrec.dat(xco-1,yco)=111 Then ' pit to the north Color 15 ' ansi color Locate xco-1,yco,0 ' position cursor Print "o"; ' display pit j=-1 ' set pit flag Endif If dungeonrec.dat(xco+1,yco)=111 Then ' pit to the south Color 15 ' ansi color Locate xco+1,yco,0 ' position cursor Print "o"; ' display pit j=-1 ' set pit flag Endif If dungeonrec.dat(xco,yco-1)=111 Then ' pit to the west Color 15 ' ansi color Locate xco,yco-1,0 ' position cursor Print "o"; ' display pit j=-1 ' set pit flag Endif If dungeonrec.dat(xco,yco+1)=111 Then ' pit to the east Color 15 ' ansi color Locate xco,yco+1,0 ' position cursor Print "o"; ' display pit j=-1 ' set pit flag Endif If i=0 And j=0 Then' no traps or pits Color 14 ' ansi color a$="There are no traps or pits here.." Else ' traps and/or pits Color 11 ' ansi color a$="You discovered some " If i And j Then ' both traps and pits a$=a$+"traps and pits.." Else ' traps or pits If i Then ' only traps a$=a$+"traps.." Else ' only pits a$=a$+"pits.." Endif Endif Endif Gosub Display.Message ' output message Gosub Pause.Second ' wait Case 8 ' pyrotechnics Gosub Pause.Second ' wait bonus=2 ' multiplier Gosub Attack.Nearby.Monsters ' attack nearby monsters Gosub Monster.Attack Gosub Encounter.Cells Case 9 ' firestorm Gosub Pause.Second ' wait bonus=2 ' multiplier Gosub Attack.Nearby.Monsters ' attack nearby monsters Gosub Monster.Attack Gosub Encounter.Cells Case 10 ' transmute Gosub Pause.Second 'pause screen ' convert surrounding cells to gold If dungeonrec.dat(xco-1,yco)=46 And xco>1 Then Color 15 ' ansi color Locate xco-1,yco,0 ' position cursor Print "$"; ' display gold dungeonrec.dat(xco-1,yco)=36 ' set dungeon cell to gold If dungeonrec.stats(12)=0 Then ' all dungeon level coins not found yet dungeonrec.stats(11)=dungeonrec.stats(11)+1 ' increment number of coins in dungeon level Endif Endif If dungeonrec.dat(xco+1,yco)=46 And xco<23 Then Color 15 ' ansi color Locate xco+1,yco,0 ' position cursor Print "$"; ' display gold dungeonrec.dat(xco+1,yco)=36 ' set dungeon cell to gold If dungeonrec.stats(12)=0 Then ' all dungeon level coins not found yet dungeonrec.stats(11)=dungeonrec.stats(11)+1 ' increment number of coins in dungeon level Endif Endif If dungeonrec.dat(xco,yco-1)=46 And yco>1 Then Color 15 ' ansi color Locate xco,yco-1,0 ' position cursor Print "$"; ' display gold dungeonrec.dat(xco,yco-1)=36 ' set dungeon cell to gold If dungeonrec.stats(12)=0 Then ' all dungeon level coins not found yet dungeonrec.stats(11)=dungeonrec.stats(11)+1 ' increment number of coins in dungeon level Endif Endif If dungeonrec.dat(xco,yco+1)=46 And yco<76 Then Color 15 ' ansi color Locate xco,yco+1,0 ' position cursor Print "$"; ' display gold dungeonrec.dat(xco,yco+1)=36 ' set dungeon cell to gold If dungeonrec.stats(12)=0 Then ' all dungeon level coins not found yet dungeonrec.stats(11)=dungeonrec.stats(11)+1 ' increment number of coins in dungeon level Endif Endif End Select Return ' exit routine ' cast spell type 2 Cast.Spell.Type2: userrec.stats2(14)=userrec.stats2(14)-2 ' decrement spell points If userrec.stats2(14)<0 Then ' not enough remaining to cast spell, userrec.stats2(14)=0 ' reset spell point counter to zero Return ' exit routine Endif Gosub Cast.Spell.Message ' display spell name being cast Select Case sp ' select spell 1 to 10 Case 1 ' restoration ' increment players hit points by constitution times two userrec.stats1(4)=userrec.stats1(4)+userrec.stats2(4) Gosub Increment.Hits ' update players combat hits Case 2 ' scare mhpm=userrec.stats2(5) ' monster hit point minus amount equal to dexterity mhpmc=2 ' monster hit point minus counter Case 3 ' fireball Gosub Pause.Second ' wait bonus=3 ' multiplier Gosub Attack.Nearby.Monsters ' attack nearby monsters Gosub Monster.Attack Gosub Encounter.Cells Case 4 ' obscurement shp=userrec.stats2(9) ' shield amount equal to players armor shpc=2 ' shield counter Case 5 ' power shield stp=userrec.stats2(1) ' strength amount equal to players strength stpc=2 ' strength counter Case 6 ' wall of will slp=1 ' sleep flag slpc=2 ' sleep counter Case 7 ' light ll=3 ' set extended cell display amount llc=1 ' set extended cell display counter Gosub Cell.Action ' compute nearby cells Case 8 ' levitate Do ' loop until empty cell to move player For k=1 To Int(Rnd*4+2) ' move player random times c=0 ' loop counter Do ' find empty cell c=c+1 ' increment counter If c>10 Then ' avoid infinite loop Exit For ' exit routine Endif cxco=xco ' store x-coordinate cyco=yco ' store y-coordinate Gosub Get.Random.Direction ' get valid random direction If Coor.Direction Then ' returned valid random direction Exit Do ' found valid random direction Endif Loop ' move to selected cell xco=xco+xo ' increment players x coordinate yco=yco+yo ' increment players y coordinate Gosub Update.Player ' update nearby cell actions Next ' get next levitate move If dungeonrec.dat(xco,yco)=46 Then ' move to an dungeon dot Exit Do ' end move player Endif Loop Case 9 ' monster summon For k=1 To Int(Rnd*4+2) ' encounter random number of monsters c=0 ' loop counter Do ' loop until empty nearby cell for monster c=c+1 ' increment loop counter If c>10 Then' avoid infinite loop Exit For ' exit more than 10 loops Endif cxco=xco ' store x-coordinate cyco=yco ' store y-coordinate Gosub Get.Random.Direction ' get valid random direction If Coor.Direction Then ' returned valid random direction If dungeonrec.dat(xco+xo,yco+yo)=46 Then ' empty dungeon cell Exit Do ' fond empty cell at random direction Endif Endif Loop mxco=xco+xo ' set monster xy myco=yco+yo ' set monster xy If dungeonrec.stats(5)=0 Then ' all dungeon level monsters not found yet dungeonrec.stats(6)=dungeonrec.stats(6)+1 ' increment number of monsters on level Endif ' set dungeon array monster xy to monster symbol dungeonrec.dat(mxco,myco)=35 Color 15 ' ansi color Locate mxco,myco,0 ' position cursor Print "#"; ' display monster symbol mn=Int(Rnd*100+1) ' select random monster Gosub Encounter.Monster ' get the monster statistics Next ' get next monster Case 10 ' finger of death Gosub Pause.Second ' wait Gosub Cell.Monster.Attack ' all nearby monsters die End Select Return ' exit routine ' cast spell type 3 Cast.Spell.Type3: userrec.stats2(15)=userrec.stats2(15)-3 ' decrement spell points If userrec.stats2(15)<0 Then ' not enough remaining to cast spell, userrec.stats2(15)=0 ' reset spell point counter to zero Return ' exit routine Endif Gosub Cast.Spell.Message ' display spell name being cast Select Case sp ' select spell 1 to 10 Case 1 ' regeneration ' increase players hit points by constitution times three x=userrec.stats2(4) x=x*2 userrec.stats1(4)=userrec.stats1(4)+x Gosub Increment.Hits ' reset any counters Case 2 'forget mhpm=userrec.stats2(5) ' monster hit point minus amount equal to players dexterity mhpmc=3 ' monster hit point minus counter Case 3 ' lightning bolt Gosub Pause.Second ' wait bonus=4 ' multiplier Gosub Attack.Nearby.Monsters ' attack nearby monsters Gosub Monster.Attack Gosub Encounter.Cells Case 4 ' phantasmal force shp=userrec.stats2(9) ' shield amount equal to players armor shpc=3 ' shield counter Case 5 ' wall of force stp=userrec.stats2(1) ' strength amount equal to players strength stpc=3 ' strength counter Case 6 ' charm monster slp=1 ' sleep flag slpc=3 ' sleep counter Case 7 ' continual light ll=2 ' set extended cell display amount llc=4 ' set extended cell display counter Gosub Cell.Action ' compute nearby cells Case 8 ' passwall If pwl=1 Then ' already in passwall mode Return ' exit routine Endif pwl=1 ' set passwall flag For q=1 To Int(Rnd*4+2) ' random amount of passwall moves Gosub Move.Passwall ' separate input loop for passwall Next ' to move through dungeon walls ' continue passwall if loop ended in dungeon wall While dungeonrec.dat(xco,yco)=176 Gosub Move.Passwall ' move until out of dungeon wall Wend ' end passwall pwl=0 ' reset passwall flag Return ' exit routine Case 9 ' demon summon For k=1 To Int(Rnd*4+2) ' encounter random number of demons c=0 ' loop counter Do ' loop until empty nearby cell for demon c=c+1 ' increment loop counter If c>10 Then ' avoid infinite loop Exit For ' exit more than ten loops Endif cxco=xco ' store x-coordinate cyco=yco ' store y-coordinate Gosub Get.Random.Direction ' get valid random direction If Coor.Direction Then ' returned valid random direction If dungeonrec.dat(xco+xo,yco+yo)=46 Then ' empty dungeon cell Exit Do ' found empty cell at random direction Endif Endif Loop If dungeonrec.stats(5)=0 Then ' all dungeon level monsters not found yet dungeonrec.stats(6)=dungeonrec.stats(6)+1 ' increment number of monsters on level Endif mxco=xco+xo ' set monster xy myco=yco+yo ' set monster xy ' set dungeon array monster xy to monster symbol dungeonrec.dat(mxco,myco)=35 Color 15 ' ansi color Locate mxco,myco,0 ' position cursor Print "#"; ' display monster symbol mn=101 ' monster number 54 is demon in data Gosub Encounter.Monster ' get the monster statistics Next ' get next demon Case 10 ' doomkill Gosub Pause.Second ' wait Gosub Cell.Monster.Attack ' all nearby monsters die End Select Return ' exit routine ' cast spell type 4 Cast.Spell.Type4: userrec.stats2(16)=userrec.stats2(16)-4 ' decrement spell points If userrec.stats2(16)<0 Then ' not enough remaining to cast spell, userrec.stats2(16)=0 ' reset spell point counter to zero Return ' exit routine Endif Gosub Cast.Spell.Message ' display spell name being cast Select Case sp ' select spell 1 to 10 Case 1 ' resurrection ' increase players hit points by constitution times four x=userrec.stats2(4) x=x*3 userrec.stats1(4)=userrec.stats1(4)+x Gosub Increment.Hits Case 2 ' fear mhpm=userrec.stats2(5) ' monster hit point minus amount equal to players dexterity mhpmc=4 ' monster hit point minus counter Case 3 ' disintegrate Gosub Pause.Second ' wait bonus=5 ' multiplier Gosub Attack.Nearby.Monsters ' attack nearby monsters Gosub Monster.Attack Gosub Encounter.Cells Case 4 ' blade barrier shp=userrec.stats2(9) ' shield amount equal to armor shpc=4 ' shield counter Case 5 ' enchanted weapon stp=userrec.stats2(1) ' strength amount equal to players strength stpc=4 ' strength counter Case 6 ' hold monster slp=1 ' sleep flag slpc=4 ' sleep counter Case 7 ' teleport Gosub Teleport ' teleport player Case 8 ' polymorph Gosub Cell.Monster.Attack ' all nearby monsters die Case 9 ' time stop pw=1 ' pass monsters flag pwc=5 ' pass monsters counter Case 10 ' genocide gd=1 ' set extended monster cell death flag gdc=4 ' set extended monster cell death counter Gosub Cell.Monster.Attack ' all nearby monsters die End Select Return ' exit routine ' passwall input routine Move.Passwall: Do ' get a keystroke Gosub Get.Keystroke ' only keystrokes allowed 0 to 9, and Loop Until (x>=0 And x<=9) Or Len(x$)=2 ' extended ascii xo=xco ' store players x-coordinate yo=yco ' store players y-coordinate Select Case Len(x$) ' process input Case 1 ' input length Select Case x$ ' select input key Case "1" ' attack nearby monsters Gosub Attack.Nearby.Monsters Gosub Monster.Attack Gosub Encounter.Cells Case "2" ' passwall move up xo=xo+1 ' increment temporary variable If xo<23 Then ' check array bounds xco=xo ' update players x-coordinate yco=yo ' update players y-coordinate Gosub Update.Player ' update nearby cell actions Endif Case "3" ' cast spell Gosub Cast.Chant Case "4" ' passwall move left yo=yo-1 ' decrement temporary variable If yo>1 Then ' check array bounds xco=xo ' update players x-coordinate yco=yo ' update players y-coordinate Gosub Update.Player ' update nearby cell actions Endif Case "5", Chr$(13) ' enter/accept key/null action Gosub Update.Hits Case "6" ' passwall move right yo=yo+1 'increment temporary variable If yo<76 Then ' check array bouns xco=xo ' update players x-coordinate yco=yo ' update players y-coordinate Gosub Update.Player ' update nearby cell actions Endif Case "7" ' evade monster Gosub Evade.Monster Case "8" ' passwall move down xo=xo-1 ' decrement temporary variable If xo>1 Then ' check array bounds xco=xo ' update players x-coordinate yco=yo ' update players y-coordinate Gosub Update.Player ' update nearby cell actions Endif Case "9" ' ignore key/null action/update hits Gosub Update.Hits End Select Case 2 ' input length sp=Asc(Mid$(x$,2)) ' convert extended ascii input Select Case sp ' select second input key, Case 79 ' 1, attack nearby monsters Gosub Attack.Nearby.Monsters Gosub Monster.Attack Gosub Encounter.Cells Case 80 ' 2, passwall move player down xo=xo+1 ' increment temporary variable If xo<23 Then ' check array bounds xco=xo ' update players x-coordinate yco=yo ' update players y-coordinate Gosub Update.Player ' update nearby cell actions Endif Case 81 ' 3, cast spell Gosub Cast.Chant Case 75 ' 4, passwall move player left yo=yo-1 ' decrement temporary variable If yo>1 Then ' check array bounds xco=xo ' update players x-coordinate yco=yo ' update players y-coordinate Gosub Update.Player ' update nearby cell actions Endif Case 76 ' 5, enter/accept key/null action Gosub Update.Hits Case 77 ' 6, passwall move player right yo=yo+1 ' increment temporary variable If yo<76 Then ' check array bounds xco=xo ' update players x-coordinate yco=yo ' update players y-coordinate Gosub Update.Player ' update nearby cell actions Endif Case 71 ' 7, evade monster Gosub Evade.Monster Case 72 ' 8, passwall move player up xo=xo-1 ' decrement temporary variable If xo>1 Then ' check array bounds xco=xo ' update players x-coordinate yco=yo ' update players y-coordinate Gosub Update.Player ' update nearby cell actions Endif Case 73 ' 9, ignore key/null action/update hits Gosub Update.Hits ' F1 to F10, cast spell type 1 Case 59 To 68 spn=1 ' set spell type sp=sp-58 ' calculate spell number Gosub Cast.Spell.Type1 ' Control-F1 to F10, cast spell type 2 Case 94 To 103 spn=2 ' set spell type sp=sp-93 ' calculate spell number Gosub Cast.Spell.Type2 ' Shift-F1 to F10, cast spell type 3 Case 84 To 93 spn=3 ' set spell type sp=sp-83 ' calculate spell number Gosub Cast.Spell.Type3 ' Alt-F1 to F10, cast spell type 4 Case 104 To 113 spn=4 ' set spell type sp=sp-103 ' calculate spell number Gosub Cast.Spell.Type4 End Select End Select Return ' exit routine ' kill all nearby monsters Cell.Monster.Attack: For mn=1 To 8 ' loop through all eight surrounding cells If monsters(mn,1) Or monsters(mn,2) Then ' monster xy exists mxco=monsters(mn,1) ' get monster x-coordinate myco=monsters(mn,2) ' get monster y-coordinate ex#=monsters(mn,5) ' get monster experience monsters(mn,1)=0 ' reset monster x-coordinate monsters(mn,2)=0 ' reset monster y-coordinate Gosub Update.Stats ' update players statistics with experience ' reset dungeon array monster to gold symbol dungeonrec.dat(mxco,myco)=36 If dungeonrec.stats(12)=0 Then ' all dungeon level coins not found yet dungeonrec.stats(11)=dungeonrec.stats(11)+1 ' increment coins in dungeon Endif Color 15 ' ansi color Locate mxco,myco,0 ' position cursor Print "$"; ' display gold dungeonrec.stats(6)=dungeonrec.stats(6)-1 ' decrement number of monsters If dungeonrec.stats(6)=0 Then ' last monster counter If dungeonrec.stats(5)=0 Then ' last monster in dungeon level flag dungeonrec.stats(5)=1 ' set last monster in dungeon level flag ' calculate bonus experience for last monster ex#=(Rnd*dlvl#*2+1)*userrec.stats1(2)^2/2 ex#=ex#+dlvl#*2+Rnd*userrec.stats1(2)*50 ex#=Int(ex#) Color 14 ' ansi color a$="You killed all the monsters on this level! You gain" a$=a$+Str$(ex#)+" experience!" Gosub Display.Message ' output message Gosub Update.Stats ' update players statistics wth experience Gosub Pause.Second ' wait Endif Endif Endif Next ' get next monster Return ' exit routine ' teleport player randomly in dungeon level to another cell Teleport: Color 7 ' display cell player will be teleported from Locate xco,yco,0 ' position cursor Print Chr$(dungeonrec.dat(xco,yco)); ' display dungeon cell symbol Do ' loop until player teleports to an empty cell txo=xco ' store players x-coordinate tyo=yco ' store players y-coordinate For k=1 To Int(Rnd*2+2) ' random number of times to teleport c=0 ' loop counter Do ' loop until empty nearby cell for demon c=c+1 ' increment loop counter If c>10 Then ' avoid infinite loop Exit For ' exit more than ten loops Endif If Rnd>.5 Then ' select teleport up 50/50 xo=-1 ' set x-coordinate increment Else ' teleport down 50/50 xo=1 ' set x-coordinate increment Endif If Rnd>.5 Then ' select teleport left 50/50 yo=-1 ' set y-coordinate increment Else ' teleport right 50/50 yo=1 ' set y-coordinate increment Endif ' until players xy-coor plus selected xy is within bounds If txo+xo>1 Then ' x-coordinate boundary If txo+xo<22 Then ' x-coordinate boundary If tyo+yo>1 Then ' y-coordinate boundary If tyo+yo<76 Then ' y-coordinate boundary If (txo+xo)<>xco Then ' not players xy-coordinate If (tyo+yo)<>yco Then ' not players xy-coordinate Exit Do Endif Endif Endif Endif Endif Endif Loop txo=txo+xo ' update stored players x-coordinate tyo=tyo+yo ' update stored players y-coordinate Next ' get next cell ' exit loop if destination teleport cell is dungeon dot If dungeonrec.dat(txo,tyo)=46 Then ' move to an dungeon dot Exit Do ' end move player Endif Loop xco=txo ' set players x-coordinate to destination x-coordinate yco=tyo ' set players y-coordinate to destination y-coordinate Gosub Update.Player ' update nearby cell actions Return ' exit routine ' display prompt, get keypress Key.Press: Color 13 ' ansi color Locate 25,35,0 ' position cursor Print "Press a key:"; ' display message Gosub Get.Key.Press ' get a single keystroke Return ' exit routine ' get a single keystroke Get.Key.Press: While Inkey$="" ' wait for any input Wend ' wait Return ' exit routine ' routine to buy player statistics with gold Trade.Stats: Gosub Store.Dungeon.Level ' store dungeon screen Color 14, 1 ' blue background Cls ' clear screen ' make statistic trading screen Color 14 ' ansi color Locate 1,25,0 ' position cursor Print "Trade Gold For Player Statistics"; Color 15 ' ansi color Locate 10,28,0 ' position cursor Print "(1) (2) (3) (4) (5) (6)"; Color 12 ' ansi color Locate 11,28,0 ' position cursor Print "Str Int Wis Con Dex Cha"; Color 13 ' ansi color Locate 13,15,0 ' position cursor Print "Purchasing Character Stats(1, 2, 3, 4, 5, or 6 to buy)"; Color 15 ' ansi color Locate 25,22,0 ' position cursor Print "Press <enter> to return to the Dungeon.."; ' calculate cost of statistic buy#=Int(Rnd*userrec.stats1(2)+5)*50+Int(Rnd*100) ' display message of cost i$="The average stat point is"+Str$(buy#)+" Gold." i=40-Int(Len(i$)/2) ' center Color 14 ' ansi color Locate 14,i,0 ' position cursor Print i$; Color 14 ' ansi color Locate 15,33,0 ' position cursor Print "Gold remaining:"; Do ' loop to select statistics Color 10 ' ansi color Locate 12,29,0 ' position cursor ' display players statistics For x=1 To 6 Print Right$(Str$(userrec.stats2(x)),2)+" "; Next Locate 16,1,0 ' position cursor Print Space$(79); ' display players gold amount remaining i=40-Len(Str$(userrec.stats1(5)))/2 ' center Color 15 ' ansi color Locate 16,i,0 ' position cursor Print Str$(userrec.stats1(5)); ' output gold amount If userrec.stats1(5)-buy#<=0 Then ' calculate gold remaining to stat cost Gosub Clear.Status.Line2 ' clear status line area Color 14 ' ansi color Locate 24,21,0 ' position cursor Print "You do not have enough Gold remaining!"; Exit Do ' exit loop Endif Do ' get a keystroke Gosub Get.Keystroke Loop Until (x>=1 And x<=6) Or x$=Chr$(13) ' presses 1 to 6 to buy statistic space to exit If x$=Chr$(13) Then ' enter pressed Gosub Clear.Status.Line2 ' clear status line area Exit Do ' exit loop Endif userrec.stats2(x)=userrec.stats2(x)+1 ' increment statistic If userrec.stats2(x)<100 Then ' check valid statistic userrec.stats1(5)=userrec.stats1(5)-buy# ' decrement gold by stat cost Else userrec.stats2(x)=99 ' reset statistic Endif Loop ' loop to get stat to buy Gosub Key.Press ' wait Gosub Restore.Screen ' redraw dungeon screen Return ' exit routine ' routine to buy inventory items with gold Buy.Inventory: Gosub Store.Dungeon.Level ' store dungeon screen Color 14, 1 ' blue background Cls ' clear screen ' make inventory buying screen Color 14 ' ansi color Locate 1,25,0 ' position cursor Print "Buy Inventory Items With Gold"; Color 15 ' ansi color Locate 10,28,0 ' position cursor Print "(1) (2) (3) (4) (5) (6)"; Color 12 ' ansi color Locate 11,29,0 ' position cursor Print "WE SH AR CL HE BO"; Color 13 ' ansi color Locate 13,15,0 ' position cursor Print "Purchasing Inventory Items(1, 2, 3, 4, 5, or 6 to buy)"; Color 15 ' ansi color Locate 25,22,0 ' position cursor Print "Press <enter> to return to the Dungeon.."; ' calculate cost of inventory item buy#=Int(Rnd*userrec.stats1(2)+5)*50+Int(Rnd*100) ' display message of cost i$="The average item point is"+Str$(buy#)+" Gold." i=40-Int(Len(i$)/2) ' center Color 14 ' ansi color Locate 14,i,0 ' position cursor Print i$; Color 14 ' ansi color Locate 15,33,0 ' position cursor Print "Gold remaining:"; Do ' loop to select item Color 10 ' ansi color Locate 12,29,0 ' position cursor ' display players statistics For x=7 To 12 Print Right$(Str$(userrec.stats2(x)),2)+" "; Next Locate 16,1,0 ' position cursor Print Space$(79); ' display players gold amount remaining i=40-Len(Str$(userrec.stats1(5)))/2 ' center Color 15 ' ansi color Locate 16,i,0 ' position cursor Print Str$(userrec.stats1(5)); ' output gold amount If userrec.stats1(5)-buy#<=0 Then ' calculate gold remaining to stat cost Gosub Clear.Status.Line2 ' clear status line area Color 14 ' ansi color Locate 24,21,0 ' position cursor Print "You do not have enough Gold remaining!"; Exit Do ' exit loop Endif Do ' get a keystroke Gosub Get.Keystroke Loop Until (x>=1 And x<=6) Or x$=Chr$(13) ' presses 1 to 6 to buy statistic space to exit If x$=Chr$(13) Then ' enter pressed Gosub Clear.Status.Line2 ' clear status line area Exit Do ' exit loop Endif userrec.stats2(x+6)=userrec.stats2(x+6)+1 ' increment inventory statistic If userrec.stats2(x+6)<100 Then ' check valid statistic userrec.stats1(5)=userrec.stats1(5)-buy# ' decrement gold by stat cost Else userrec.stats2(x+6)=99 ' reset statistic Endif Loop ' loop to get stat to buy Gosub Key.Press ' wait Gosub Restore.Screen ' redraw dungeon screen Return ' exit routine ' display screen of players learned spells Learned.Spells: Gosub Store.Dungeon.Level ' store dungeon screen Color 14, 1 ' blue background Cls ' clear screen ' make learned spells screen Locate 1,15,0 ' position cursor Color 15 ' ansi color Print "Your player has memorized the following spell chants:"; ' restore data pointer to spell data Color 14 ' ansi color Restore Spell.Data For i=1 To 40 ' loop through 40 spells Read b$, c$ ' read spell chant, spell name If userrec.spell(i) Then ' spells array element flag If i>20 Then ' place first 20 on left side of screen Locate i-17,5,0 ' position cursor Print b$; ' append spell name Else ' place second 20 on right side of screen Locate i+3,45,0 ' position cursor Print b$; ' append spell name Endif Endif Next ' get next spell Gosub Key.Press ' wait Gosub Restore.Screen ' redraw dungeon screen Return ' exit routine ' display screen of players inventory Inventory: Gosub Store.Dungeon.Level ' store dungeon screen Color 14, 1 ' blue background Cls ' clear screen ' make inventory display screen Color 15 ' ansi color Locate 1,15,0 ' position cursor Print "Your player has collected the following items:"; ' display wands and potions on left side of screen Color 10 ' ansi color Locate 2,5,0 ' position cursor Print "Key: Alt-"; ' display key command for wands Locate 2,45,0 ' position cursor Print "Key: Alt-"; ' display key command for potions Color 14 ' ansi color Restore Wand.Data ' restore data pointer to wand data For i=1 To 10 ' loop through 10 wands Read b$, x ' read wand name, wand spell number If userrec.wand(i) Then ' check wands array element flag Locate i+2,5,0 ' position cursor Print "("+Chr$(i+64)+")wand of "+b$; ' append wand name Endif Next Restore Potion.Data ' restore data pointer to potion data For i=1 To 10 ' loop through 10 potions Read b$, x ' read potion name, spell number If userrec.potion(i) Then ' check potions array element flag Locate i+2,45,0 ' position cursor Print "("+Chr$(i+80)+")potion of "+b$; ' append potion name Endif Next Color 10 ' ansi color Locate 14,5,0 ' position cursor Print "Key: Control-"; ' display key command for staffs Locate 14,45,0 ' position cursor Print "Key: Control-"; ' display key command for rings Color 14 ' ansi color Restore Staff.Data ' restore data pointer to staff data For i=1 To 10 ' loop through 10 staffs Read b$, x ' read staff name, staff spell number If userrec.staff(i) Then ' check staff array element flag Locate i+14,5 ' position cursor Print "("+Chr$(i+64)+")staff of "+b$; ' append staff name Endif Next Restore Ring.Data ' restore data pointer to ring data For i=1 To 10 ' loop through 10 rings Read b$, x ' read ring name, ring spell number If userrec.ring(i) Then ' check ring array element flag Locate i+14,45,0 ' position cursor Print "("+Chr$(i+80)+")ring of "+b$; ' append ring name Endif Next Gosub Key.Press ' wait Gosub Restore.Screen ' redraw dungeon screen Return ' exit routine ' open the user file, length of user record Open.User.File: Close 1 ' close file 1 ' open user file random Open "players.dat" For Random Shared As #1 Len=Len(userrec) Return ' exit routine ' open the data file, length of dungeon record Open.Data.File: Close 2 ' close file 2 ' name the data file to store the dungeon statistics, ' the extension being the users index padded in zeroes filename$="datafile."+Right$(Str$(ux+1000),3) ' open the file, randomly, length of the record equal to ' the record structure containing the dungeon level data Open filename$ For Random Shared As #2 Len=Len(dungeonrec) Return ' exit routine ' store user record and data to user file, at user record number Put.User.File: userrec.codename=fnencrypt$(code$) ' store encrypted codename in user record userrec.password=fnencrypt$(pass$) ' store encrypted password in user record Put 1,ux,userrec ' put user record into user index number Return ' exit routine ' create new dungeon level Make.Dungeon: Color 14, 1 ' blue background Cls ' clear screen Color 13 ' ansi color Locate 12,27,0 ' position cursor Print "Creating Dungeon Level"; ' display dungeon level being created Print Str$(dlvl#); ' dungeon level Color 7 ' ansi color Gosub Pause.Second ' wait Gosub Pause.Second ' wait Gosub Pause.Second ' wait ll=1 ' reset extended cell display amount llc=0 ' reset extended cell display counter For i=0 To 26 ' clear temporary dungeon arrays For j=0 To 11 w(i,j)=0 v(i,j)=0 Next Next ' reset temporary dungeon creation counters q=0 z=0 x=Int(Rnd*26+1) c=1 w(x,1)=c c=c+1 r=x s=1 ' following source code makes a maze in v, and w. ' probably cannot be restructured.. Goto 2540 2440 IF R<>26 Then 2520 IF S<>11 Then 2490 R=1 S=1 Goto 2530 2490 R=1 S=S+1 Goto 2530 2520 R=R+1 2530 IF W(R,S)=0 Then 2440 2540 IF R-1=0 Then 2830 IF W(R-1,S) Then 2830 IF S-1=0 Then 2680 IF W(R,S-1) Then 2680 IF R=26 Then 2610 IF W(R+1,S) Then 2610 X=INT(RND*3+1):ON X Goto 3140,3210,3280 2610 IF S<>11 Then 2650 IF Z=1 Then 2670 Q=1 Goto 2660 2650 IF W(R,S+1) Then 2670 2660 X=INT(RND*3+1):ON X Goto 3140,3210,3370 2670 X=INT(RND*2+1):ON X Goto 3140,3210 2680 IF R=26 Then 2770 IF W(R+1,S) Then 2770 IF S<>11 Then 2740 IF Z=1 Then 2760 Q=1 Goto 2750 2740 IF W(R,S+1) Then 2760 2750 X=INT(RND*3+1):ON X Goto 3140,3280,3370 2760 X=INT(RND*2+1):ON X Goto 3140,3280 2770 IF S<>11 Then 2810 IF Z=1 Then 3140 Q=1 Goto 2820 2810 IF W(R,S+1) Then 3140 2820 X=INT(RND*2+1):ON X Goto 3140,3370 2830 IF S-1=0 Then 3000 IF W(R,S-1) Then 3000 IF R=26 Then 2940 IF W(R+1,S) Then 2940 IF S<>11 Then 2910 IF Z=1 Then 2930 Q=1 Goto 2920 2910 IF W(R,S+1) Then 2930 2920 X=INT(RND*3+1):ON X Goto 3210,3280,3370 2930 X=INT(RND*2+1):ON X Goto 3210,3280 2940 IF S<>11 Then 2980 IF Z=1 Then 3210 Q=1 Goto 2990 2980 IF W(R,S+1) Then 3210 2990 X=INT(RND*2+1):ON X Goto 3210,3370 3000 IF R=26 Then 3080 IF W(R+1,S) Then 3080 IF S<>11 Then 3060 IF Z=1 Then 3280 Q=1 Goto 3220 3060 IF W(R,S+1) Then 3280 X=INT(RND*2+1):ON X Goto 3280,3370 3080 IF S<>11 Then 3120 IF Z=1 Then 2440 Q=1 Goto 3370 3120 IF W(R,S+1) Then 2440 Goto 3370 3140 W(R-1,S)=C C=C+1 V(R-1,S)=2 R=R-1 IF C=287 Then 3570 Q=0 Goto 2540 3210 W(R,S-1)=C 3220 C=C+1 V(R,S-1)=1 S=S-1 IF C=287 Then 3570 Q=0 Goto 2540 3280 W(R+1,S)=C C=C+1 IF V(R,S)=0 Then 3330 V(R,S)=3 Goto 3340 3330 V(R,S)=2 3340 R=R+1 IF C=287 Then 3570 Goto 2830 3370 IF Q=1 Then 3470 W(R,S+1)=C C=C+1 IF V(R,S)=0 Then 3430 V(R,S)=3 Goto 3440 3430 V(R,S)=1 3440 S=S+1 IF C=287 Then 3570 Goto 2540 3470 Z=1 IF V(R,S)=0 Then 3520 V(R,S)=3 Q=0 Goto 2440 3520 V(R,S)=1 Q=0 R=1 S=1 Goto 2530 3570 ' maze maker ends here.. For i=1 To 24 ' clear maze array For j=1 To 80 dungeonrec.dat(i,j)=46 ' with dungeon dots Next Next For j=1 To 11 ' convert array to maze For i=1 To 26 If v(i,j)<2 Then dungeonrec.dat(j*2,i*3-1)=46 dungeonrec.dat(j*2,i*3)=46 dungeonrec.dat(j*2,i*3+1)=176 Else dungeonrec.dat(j*2,i*3-1)=46 dungeonrec.dat(j*2,i*3)=46 dungeonrec.dat(j*2,i*3+1)=46 Endif Next For i=1 To 26 If v(i,j)=0 Or v(i,j)=2 Then dungeonrec.dat(j*2+1,i*3-2)=176 dungeonrec.dat(j*2+1,i*3-1)=176 dungeonrec.dat(j*2+1,i*3)=176 Else dungeonrec.dat(j*2+1,i*3-2)=176 dungeonrec.dat(j*2+1,i*3-1)=46 dungeonrec.dat(j*2+1,i*3)=46 Endif Next Next For i=1 To 80 ' border dungeonrec.dat(1,i)=176 dungeonrec.dat(23,i)=176 Next For i=1 To 24 ' border dungeonrec.dat(i,1)=176 dungeonrec.dat(i,79)=176 Next ' dat() now contains borderlike dungeon/maze u1=0 ' set room total gold items counter u2=0 ' set room total coins items counter u3=0 ' set room total gems items counter For p=1 To 4 ' make four rooms Select Case p Case 1 ' first room m=Int(Rnd*6+2) ' room x-coordinate n=Int(Rnd*30+2) ' room y-coordinate in upper-left half of dungeon Case 2 ' second room m=Int(Rnd*6+2) ' room x=coordinate n=Int(Rnd*32+40) ' room y-coordinate in upper-right half of dungeon Case 3 ' third room m=Int(Rnd*10+8) ' room x=coordinate n=Int(Rnd*30+2) ' room y-coordinate in lower-left half of dungeon Case 4 ' fourth room m=Int(Rnd*10+8) ' room x=coordinate n=Int(Rnd*32+40) ' room y-coordinate in lower-right half of dungeon End Select x1=4 ' size of room side y1=6 ' size of room side For q1=0 To x1 ' make room border dungeonrec.dat(m+q1,n)=21+p ' specific border character dungeonrec.dat(m+q1,n+y1)=21+p ' specific border character Next For q1=0 To y1 ' make room border dungeonrec.dat(m,n+q1)=21+p ' specific border character dungeonrec.dat(m+x1,n+q1)=21+p ' specific border character Next Select Case Int(Rnd*3+1) ' select item to fill room Case 1 ' gold t=36 ' gold symbol u1=u1+15 ' total room gold added Case 2 ' coins t=38 ' coins symbol u2=u2+15 ' total room coins added Case 3 ' gems t=42 ' gems symbol u3=u3+15 ' total room gems added End Select ' end select item For q1=m+1 To m+x1-1 ' loop through inside of room For q2=n+1 To n+y1-1 ' loop through inside of room dungeonrec.dat(q1,q2)=t Next ' end room contents loop Next ' end room contents loop Next ' end make rooms Do ' loop until dungeon dot found m=Int(Rnd*20+2) n=Int(Rnd*76+2) Loop Until dungeonrec.dat(m,n)=46 dungeonrec.dat(m,n)=62 ' staircase up ('>') Do ' loop until dungeon dot found m=Int(Rnd*20+2) n=Int(Rnd*76+2) Loop Until dungeonrec.dat(m,n)=46 dungeonrec.dat(m,n)=60 ' staircase down ('<') Color 14, 1 ' blue background Cls ' clear screen Color 13 ' ansi color Locate 12,25,0 ' position cursor Print "Replenishing Dungeon Level"; ' make message Print Str$(dlvl#); ' dungeon level being replenished Color 7 ' ansi color Gosub Pause.Second ' wait Gosub Pause.Second ' wait Gosub Pause.Second ' wait Gosub Replenish.Dungeon ' add dungeon symbols/characters Color 14, 1 ' blue background Cls ' clear screen Do ' loop until dungeon dot found xco=Int(Rnd*20+2) ' select player x-coordinate yco=Int(Rnd*76+2) ' select player y-coordinate Loop Until dungeonrec.dat(xco,yco)=46 ' loop until dungeon dot found u1=0 ' reset room total gold in rooms u2=0 ' reset room total coins in rooms u3=0 ' reset room total gems in rooms Return ' exit routine ' reset any dungeon symbols/characters to dungeon dot, ' except for stairs up/down Zero.Dungeon: For i=1 to 24 ' loop through z-maze For j=1 to 80 Select Case dungeonrec.dat(i,j) ' find symbol Case 35, 126, 94, 36, 111, 33, 63, 42, 38, 254, 124, 64, 37, 34 dungeonrec.dat(i,j)=46 ' reset to dungeon dot End Select Next Next Return ' exit routine ' calculate price of entire dungeon ' add number of dungeon symbols/characters, ' except for stairs up/down Dungeon.Worth: k=0 ' counter For i=1 to 24 ' loop through z-maze For j=1 to 80 Select Case dungeonrec.dat(i,j) ' select symbol Case 35, 126, 94, 36, 111, 33, 63, 42, 38, 254, 124, 64, 37, 34 k=k+1 ' increment counter End Select Next Next ' calculate price according to random values and counter temp#=(Rnd*dlvl#*2+1)*userrec.stats1(2)^2/2 temp#=temp#+dlvl#*2+Rnd*userrec.stats1(2)*50 temp#=temp#*k userrec.stats1(5)=userrec.stats1(5)+Int(temp#) Return ' exit routine ' restore dungeon with new symbols/characters Replenish.Dungeon: dungeonrec.stats(4)=0 ' all level counters dungeonrec.stats(6)=0 ' number of monster dungeonrec.stats(5)=0 ' all monsters dead flag For i=1 To Int(Rnd*10+10) ' random loop number Do ' loop until dungeon dot found m=Int(Rnd*20+2) ' calculate x-coordinate n=Int(Rnd*76+2) ' calculate y-coordinate Loop Until dungeonrec.dat(m,n)=46 ' xy-coordinate is empty dungeonrec.dat(m,n)=35 ' make cell monster symbol dungeonrec.stats(6)=dungeonrec.stats(6)+1 ' increment number of monsters Next ' loop through dungeonrec.stats(7)=0 ' number of scrolls dungeonrec.stats(8)=0 ' all scrolls found flag For i=1 To Int(Rnd*10+5) ' random loop number Do ' loop until dungeon dot found m=Int(Rnd*20+2) ' calculate x-coordinate n=Int(Rnd*76+2) ' calculate y-coordinate Loop Until dungeonrec.dat(m,n)=46 ' xy-coordinate is empty dungeonrec.dat(m,n)=126 ' make cell scroll symbol dungeonrec.stats(7)=dungeonrec.stats(7)+1 ' increment number of scrolls Next ' loop through dungeonrec.stats(9)=0 'number of traps dungeonrec.stats(10)=0 ' all traps found flag For i=1 To Int(Rnd*10+5) ' random loop number Do ' loop until dungeon dot found m=Int(Rnd*20+2) ' calculate x-coordinate n=Int(Rnd*76+2) ' calculate y-coordinate Loop Until dungeonrec.dat(m,n)=46 ' xy-coordinate empty dungeonrec.dat(m,n)=94 ' make cell trap symbol dungeonrec.stats(9)=dungeonrec.stats(9)+1 ' increment number of traps Next ' loop through dungeonrec.stats(11)=u1 ' number of gold dungeonrec.stats(12)=0 ' all gold found flag For i=1 To Int(Rnd*10+10) ' random loop number Do ' loop until dungeon dot found m=Int(Rnd*20+2) ' calculate x-coordinate n=Int(Rnd*76+2) ' calculate y-coordinate Loop Until dungeonrec.dat(m,n)=46 ' xy-coordinate empty dungeonrec.dat(m,n)=36 ' make cell gold symbol dungeonrec.stats(11)=dungeonrec.stats(11)+1 ' increment number of gold Next ' loop through dungeonrec.stats(13)=0 ' number of pits dungeonrec.stats(14)=0 ' all pits found flag For i=1 To Int(Rnd*10+5) ' random loop number Do ' loop until dungeon dot found m=Int(Rnd*20+2) ' calculate x-coordinate n=Int(Rnd*76+2) ' calculate y-coordinate Loop Until dungeonrec.dat(m,n)=46 ' xy-coordinate empty dungeonrec.dat(m,n)=111 ' make cell pit symbol dungeonrec.stats(13)=dungeonrec.stats(13)+1 ' increment number of pits Next ' loop through dungeonrec.stats(15)=0 ' number of teleporters dungeonrec.stats(16)=0 ' all teleporters found flag For i=1 To Int(Rnd*5+5) ' random loop number Do ' loop until dungeon dot found m=Int(Rnd*20+2) ' calculate x-coordinate n=Int(Rnd*76+2) ' calculate y-coordinate Loop Until dungeonrec.dat(m,n)=46 ' xy-coordinate empty dungeonrec.dat(m,n)=33 ' make cell teleporter symbol dungeonrec.stats(15)=dungeonrec.stats(15)+1 ' increment number of teleporters Next ' loop through dungeonrec.stats(17)=0 ' number of temples dungeonrec.stats(18)=0 ' all temples found flag For i=1 To Int(Rnd*5+5) ' random loop number Do ' loop until dungeon dot found m=Int(Rnd*20+2) ' calculate x-coodirnate n=Int(Rnd*76+2) ' calculate y-coordinate Loop Until dungeonrec.dat(m,n)=46 ' xy-coordinate empty dungeonrec.dat(m,n)=63 ' make cell temple symbol dungeonrec.stats(17)=dungeonrec.stats(17)+1 ' increment number of temples Next ' loop through dungeonrec.stats(19)=u3 ' number gems dungeonrec.stats(20)=0 ' all gems found flag For i=1 To Int(Rnd*10+5) ' random loop number Do ' loop until dungeon dot found m=Int(Rnd*20+2) ' calculate x-coordinate n=Int(Rnd*76+2) ' calculate y-coordinate Loop Until dungeonrec.dat(m,n)=46' xy-coordinate empty dungeonrec.dat(m,n)=42 ' make cell gem symbol dungeonrec.stats(19)=dungeonrec.stats(19)+1 ' increment number of gems Next ' loop through dungeonrec.stats(21)=u2 ' number of coins dungeonrec.stats(22)=0 ' all coins found flag For i=1 To Int(Rnd*10+5) ' random loop number Do ' loop until dungeon dot found m=Int(Rnd*20+2) ' calculate x-coordinate n=Int(Rnd*76+2) ' calculate y-coordinate Loop Until dungeonrec.dat(m,n)=46 ' xy-coordinate empty dungeonrec.dat(m,n)=38 ' make cell coins symbol dungeonrec.stats(21)=dungeonrec.stats(21)+1 ' increment number of coins Next ' loop through dungeonrec.stats(23)=0 ' number of chests dungeonrec.stats(24)=0 ' all chests found flag For i=1 To Int(Rnd*10+5) ' random loop number Do ' loop until dungeon dot found m=Int(Rnd*20+2) ' calculate x-coordinate n=Int(Rnd*76+2) ' calculate y-coordinate Loop Until dungeonrec.dat(m,n)=46 ' xy-coordinate empty dungeonrec.dat(m,n)=254 ' make cell chest symbol dungeonrec.stats(23)=dungeonrec.stats(23)+1 ' increment number of chests Next ' loop through dungeonrec.stats(25)=0 ' number of wands dungeonrec.stats(26)=0 ' all wands found flag For i=1 To Int(Rnd*5+2) ' random loop number Do ' loop until dungeon dot found m=Int(Rnd*20+2) ' calculate x-coordinate n=Int(Rnd*76+2) ' calculate y-coordinate Loop Until dungeonrec.dat(m,n)=46 ' xy-coordinate empty dungeonrec.dat(m,n)=124 ' make cell wand symbol dungeonrec.stats(25)=dungeonrec.stats(25)+1 ' increment number of wands Next ' loop through dungeonrec.stats(27)=0 ' number of potions dungeonrec.stats(28)=0 ' all potions found flag For i=1 To Int(Rnd*5+2) ' random loop number Do ' loop until dungeon dot found m=Int(Rnd*20+2) ' calculate x-coordinate n=Int(Rnd*76+2) ' calculate y-coordinate Loop Until dungeonrec.dat(m,n)=46 ' xy-coordinate empty dungeonrec.dat(m,n)=64 ' make cell potion symbol dungeonrec.stats(27)=dungeonrec.stats(27)+1 ' increment number of potions Next ' loop through dungeonrec.stats(29)=0 ' number of staffs dungeonrec.stats(30)=0 ' all staffs found flag For i=1 To Int(Rnd*5+2) ' random loop number Do ' loop until dungeon dotfound m=Int(Rnd*20+2) ' calculate x-coordinate n=Int(Rnd*76+2) ' calculate y-coordinate Loop Until dungeonrec.dat(m,n)=46 ' xy-coordinate empty dungeonrec.dat(m,n)=37 ' make cell staff symbol dungeonrec.stats(29)=dungeonrec.stats(29)+1 ' increment number of staffs Next ' loop through dungeonrec.stats(31)=0 ' number of rings dungeonrec.stats(32)=0 ' all rings found flag For i=1 To Int(Rnd*5+2) ' random loop number Do ' loop until dungeon dot found m=Int(Rnd*20+2) ' calculate x-coordinate n=Int(Rnd*76+2) ' calculate y-coordinate Loop Until dungeonrec.dat(m,n)=46 ' xy-coordinate empty dungeonrec.dat(m,n)=34 ' make cell ring symbol dungeonrec.stats(31)=dungeonrec.stats(31)+1 ' increment number of rings Next ' loop through Return ' exit routine ' compute nearby cell activity Cell.Action: Gosub Display.Cells ' display cells around player Gosub Monster.Attack ' monsters attack player Gosub Move.Monsters ' monsters move nearer to player Gosub Encounter.Cells ' nearby cells repopulated with monster symbols Return ' exit routine ' display dungeon cells surrouding the players X characters, ' ll being the length of area displayed around player Display.Cells: Color 7 ' calculate boundaries x1=xco-ll ' calculate area of surrounding cells to display While x1<1 ' keep loop counter in bounds x1=x1+1 ' increment x1 loop counter Wend ' end loop bounds counter y1=yco-ll ' calculate area of surrounding cells to display While y1<1 ' keep loop counter in bounds y1=y1+1 ' increment y1 loop counter Wend ' end loop bounds counter x2=xco+ll ' calculate area of syrrounding cells to display While x2>23 ' keep loop counter in bounds x2=x2-1 ' decrement x2 loop counter Wend ' end loop bounds counter y2=yco+ll ' calculate area of surrounding cells to display While y2>79 ' keep loop counter in bounds y2=y2-1 ' decrment y2 loop counter Wend ' end loop bounds counter uf=0 ' xy coordinate room display flag For i=x1 To x2 ' loop surrounding players xy-coordinate For j=y1 To y2 ' surrounding y-coordinate Locate i,j,0 ' locate at xy cell display t=dungeonrec.dat(i,j) ' get symbol at xy in maze u=t ' store xy maze symbol If t=94 Or t=111 Then ' traps/pits t=46 ' display dungeon dot Endif If i=xco And j=yco Then ' xy is the players X character If t<>176 Then ' and is not a dungeon wall t=88 ' display an X Endif Endif If t=46 Or t=176 Then ' xy is dungeon dot/wall Color 7 ' color white Else ' otherwise Color 15 ' color highlight white Endif If u>21 And u<26 Then ' xy is room border If uf=0 Then ' room has been displayed uf=-1 Gosub Display.Dungeon.Room ' display entire room Endif Else Print Chr$(t); ' display dungeon square symbol Endif Next ' loop all nearby cells Next Color 7 ' ansi color Return ' exit routine ' display entire room next to room border character Display.Dungeon.Room: ' dungeonrec.dat(i,j) is character 22 (room border) rx=i ' room border counter ry=j ' room border counter For q1=rx-4 To rx+4 ' loop any xy-coordinates around room For q2=ry-6 To ry+6 ' loop any xy-coordinates around room If q1>1 And q1<23 Then ' check array bounds If q2>1 And q2<79 Then ' check array bounds If dungeonrec.dat(q1,q2)=t Then ' xy-coordinate is room border Locate q1,q2,0 ' locate at room border Print Chr$(176); ' display room border Endif Endif Endif Next Next Return ' exit routine ' monsters attack the player Monster.Attack: If slp=1 Then ' sleep flag Return ' exit routine Endif For mn=1 To 8 ' loop through monster array mxco=monsters(mn,1) ' get monster x-coordinate myco=monsters(mn,2) ' get monster y-coordinate If mxco Or myco Then x=Abs(xco-mxco) ' calculate distance from players xy y=Abs(yco-myco) If (x+y)=1 Or (x=1 And y=1) Then ' distance one square from player ' calculate monsters hits on player x=0 ' calculate shield For i=8 To 11 x=x+userrec.stats2(i) Next x=x+shp+1 mhp#=Int(Rnd*(monsters(mn,4)/x)+monsters(mn,3)-mhpm) ' display hits on player Color 14 ' ansi color a$="The "+monstername(monsters(mn,6))+" attacks you! " If mhp#<=0 Then ' monster missed a$=a$+"It missed!" ' make display message Gosub Display.Message ' output message Else Gosub Hit.Player ' hit player for monsters hit attack points If dlvl#=0 Then ' player died login=0 ' player leaves dungeon Return ' exit routine Endif Endif Endif Endif Next Return ' exit routine ' move monster symbols one cell nearer player Move.Monsters: If pw=1 Then ' pass monsters flag Return ' exit routine Endif For mn=1 To 8 ' loop through monsters mxco=monsters(mn,1) ' get monster x-coordinate myco=monsters(mn,2) ' get monster y-coordinate If mxco Or myco Then ' active monster xy-coordinates ' get distance to monster from players xy, ' standard hypotenuse formula for right angle. di=Int(Sqr((mxco-xco)^2+(myco-yco)^2)) Select Case di Case 1 ' monster next to player If monsters(mn,4)<=10 Then ' monster is weak Gosub Monster.Evade Endif Case 2 ' monster is two squares away ' move monster closer u=Sgn(xco-mxco) ' store monsters xy-coordinates v=Sgn(yco-myco) ' distance one square from player ' recalculated monsters xy-coordinates can move to empty cell If dungeonrec.dat(mxco+u,myco+v)=46 Then Color 7 ' ansi color Locate mxco,myco,0 ' position cursor Print "."; ' clear monster with dungeon dot ' reset old dungeon array cell to dungeon dot dungeonrec.dat(mxco,myco)=46 Color 15 ' ansi color mxco=mxco+u ' increment monster array x-coordinate myco=myco+v ' increment monster array y-coordinate Locate mxco,myco,0 ' position cursor Print "#"; ' and display monster symbol closer monsters(mn,1)=mxco ' reset monster array x-coordinate monsters(mn,2)=myco ' reset monster array y-coordinate ' reset new dungeon array cell to monster symbol dungeonrec.dat(mxco,myco)=35 Endif Case Else ' beyond player square range monsters(mn,1)=0 ' set monsters xy-coordinates to zero monsters(mn,2)=0 End Select Endif Next Return ' exit routine ' monster evades player Monster.Evade: Color 7 ' ansi color Locate mxco,myco,0 ' position cursor Print "."; ' clear monster with dungeon dot ' reset old dungeon array cell to dungeon dot dungeonrec.dat(mxco,myco)=46 Do ' loop until empty cell to move monster For k=1 To Int(Rnd*2+2) ' random number of moves c=0 ' loop counter Do ' loop until empty nearby cell for demon c=c+1 ' increment loop counter If c>10 Then ' avoid infinite loop Exit For ' exit more than ten loops Endif cxco=mxco ' store x-coordinate cyco=myco ' store y-coordinate Gosub Get.Random.Direction ' get valid random direction If Coor.Direction Then ' returned valid random direction If dungeonrec.dat(mxco+xo,myco+yo)=46 Then ' empty dungeon cell Exit Do ' found empty cell at random direction Endif Endif Loop mxco=mxco+xo ' increment monster x coordinate myco=myco+yo ' increment monster y coordinate Next ' get next move If dungeonrec.dat(xco,yco)=46 Then ' move to an dungeon dot Exit Do ' end move monster Endif Loop ' available empty cell evade, Color 15 ' ansi color Locate mxco,myco,0 ' position cursor Print "#"; ' and display monster symbol closer ' set dungeon array monster xy to monster symbol monsters(mn,1)=mxco ' reset monster array x-coordinate monsters(mn,2)=myco ' reset monster array y-coordinate ' reset new dungeon array cell to monster symbol dungeonrec.dat(mxco,myco)=35 Return ' exit routine ' get any monsters nearby players dungeon cell Encounter.Cells: x1=xco-ll ' calculate area of surrounding cells While x1<1 ' compare bounds x1=x1+1 ' increment coordinate Wend y1=yco-ll ' calculate area of surrounding cells While y1<1 ' compare bounds y1=y1+1 ' increment coordinate Wend x2=xco+ll ' calculate area of surrounding cells While x2>23 ' compare bounds x2=x2-1 ' decrement coordinate Wend y2=yco+ll ' calculate area of surrounding cells While y2>79 ' compare bounds y2=y2-1 ' decrement coordinate Wend For mxco=x1 To x2 ' distance of cell display amount For myco=y1 To y2 ' surrounding player If dungeonrec.dat(mxco,myco)=35 Then ' dungeon contains monster at xy mn=Int(Rnd*100+1) ' select random monster name Gosub Encounter.Monster ' get monster statistics Endif Next Next ' loop through all cells Return ' exit routine ' puts monsters statistics in monster array, ' dependent on monster at xy-coordinate in mxco,myco Encounter.Monster: ' verify monster does not already exist in monster array For w=1 To 8 ' loop through monster xy array If monsters(w,1)=mxco And monsters(w,2)=myco Then ' monster at xy already Return ' exit routine Endif Next ' find empty monster array xy-coordinates For w=1 To 8 ' loop through monster xy array If monsters(w,1)=0 And monsters(w,2)=0 Then ' empty monster xy array found bonus=0 If mn=101 Then ' monster selection is demon bonus=5 Endif mlvl#=Int(Rnd*(dlvl#+bonus)+(dlvl#+bonus)/2+1) ' calculate monster level ' calculate monsters hit points by random values hp#=Int((Rnd*dlvl#*2+1)*mlvl#^2/2+dlvl#*2+Rnd*mlvl#*50) ' calculate monsters experience by random values ex#=Int(hp#/mlvl#)*Int(dlvl#/2+1)+Int(Rnd*hp#) monsters(w,1)=mxco ' store monster x-coordinate monsters(w,2)=myco ' store monster y-coordinate monsters(w,3)=mlvl# ' store monster level monsters(w,4)=hp# ' store monster hit points monsters(w,5)=ex# ' store monster experience monsters(w,6)=mn ' store monster number Exit For ' exit loop Endif Next Return ' exit routine ' hits player for points in mhp# Hit.Player: Color 14 ' ansi color If mhp#=0 Then ' calculate hits on player if mhp# is zero mhp#=Int(Rnd*dlvl#*10+1)-userrec.stats2(2) ' calculate hits If mhp#<=0 Then ' zero or less hits Gosub Display.Message ' output prepared message Gosub Pause.Second ' wait Return ' exit routine Endif Endif ' precalculated hits on player, mhp# a$="It hit you for"+Str$(mhp#)+" hits!" ' make display message Gosub Display.Message ' output message Gosub Pause.Second ' wait ' decrease players current hits remaining by mhp# points userrec.stats1(4)=userrec.stats1(4)-mhp# If userrec.stats1(4)>0 Then ' players hits less than zero Return ' exit routine Endif ' player loses a level ' decrement players maximum hits to lower level userrec.stats1(6)=userrec.stats1(6)-userrec.stats2(4) If userrec.stats1(6)<15 Then ' compute minimum players max hits variable userrec.stats1(6)=15 ' reset to 15, the minimum Endif userrec.stats1(4)=userrec.stats1(6) ' reset current hits to lower max hits userrec.stats1(2)=userrec.stats1(2)-1 ' decrement players level by one ' recalculate experience needed for next level x#=userrec.stats1(2)+5 y#=2^x# userrec.stats1(3)=y# If userrec.stats1(2)>0 Then ' players level is zero Return ' exit routine Endif ' player died userrec.stats1(2)=1 ' reset player to level one userrec.stats1(4)=15 ' reset players hits userrec.stats1(6)=15 ' reset players maximum hits ' make player died message prompt Color 31 ' ansi color a$="You died!(press 5 to exit the dungeon)" Gosub Display.Message Do ' get a keystroke Gosub Get.Keystroke Loop Until x=5 ' presses enter/5 to exit Color 7 ' ansi color Gosub Store.Dungeon.Level ' store dungeon array/screen ' player exits to dungeon level zero, main input loop exits when zero. dlvl#=0 x=userrec.stats1(2)*10 ' reset players spell points userrec.stats2(13)=x userrec.stats2(14)=x userrec.stats2(15)=x userrec.stats2(16)=x Return ' exit routine ' global error routine Error.Routine: Beep:Beep:Beep ' alert sound Resume Error.Trap ' resume to error exit routine ' error exit routine Error.Trap: Color 7,0 ' reset ansi Cls ' clear screen Locate 10,10 ' locate message Print "The Dungeon Crashed! (Error:"+Str$(Err)+")" ' print message End ' end program ' four levels of spell chants and names Spell.Data: Data "i cleanse thy body","heal" Data "i protect thee","protection" Data "darts fly from my hands","magic missile" Data "i shield thee","shield" Data "i strengthen thee","strength" Data "your eyes shut tight","sleep" Data "objects become visible","locate" Data "flames fly from my fingertips","pyrotechnics" Data "i call upon winds of fire","firestorm" Data "i create gold from air","transmute" Data "i restore thee","restoration" Data "fright causes you to falter","scare" Data "balls of fire engulf you","fireball" Data "it becomes hard to see","obscurement" Data "a shield for my body","power shield" Data "i will a wall","wall of will" Data "i must see","light" Data "gravity leaves","levitate" Data "rise from the dead","monster summon" Data "i point and you die","finger of death" Data "i regenerate thee","regeneration" Data "you must not remember","forget" Data "a bolt from hell carries thee away","lightning bolt" Data "multicolored shield protect me","phantasmal force" Data "i create a wall","wall of force" Data "i cast sleep unto your eyes","charm monster" Data "i will see more","continual light" Data "i will travel through thee","passwall" Data "monsters of hell hear me","demon summon" Data "you will all die","doomkill" Data "i resurrect thee","resurrection" Data "i frighten thee","fear" Data "you turn to dust","disintegrate" Data "swirling swords slice you","blade barrier" Data "may my weapon become powerful","enchanted weapon" Data "you are binded tightly","hold monster" Data "i travel to parts unknown","teleport" Data "you become another","polymorph" Data "let me pass","time stop" Data "everything dies continuously","genocide" ' ten wand spells, and spell number Wand.Data: Data "magic missile",3,"pyrotechnics",8,"firestorm",9,"fireball",13 Data "finger of death",20,"lightning bolt",23,"doomkill",30 Data "disintegrate",33,"blade barrier",34,"genocide",40 ' ten potion spells, and spell number Potion.Data: Data "heal",1,"protection",2,"shield",4,"strength",5 Data "restoration",11,"power shield",15,"wall of will",16 Data "regeneration",21,"phantasmal force",24,"resurrection",31 ' ten staff spells, and spell number Staff.Data: Data "locate",7,"transmute",10,"light",17,"levitate",18 Data "continual light",27,"passwall",28,"fear",32 Data "enchanted weapon",35,"teleport",37,"time stop",39 ' ten ring spells, and spell number Ring.Data: Data "sleep",6,"scare",12,"obscurement",14,"monster summon",19 Data "forget",22,"wall of force",25,"charm monster",26 Data "demon summon",29,"hold monster",36,"polymorph",38 ' 100 monster names Monster.Data: Data algoid,ankheg,azer,baku,bandit,basilisk,bat,bear,beetle,beholder,bowler Data bugbear,bullywug,caterwaul,centipede,chimera,cloaker,cockatrice,corpse Data crawler,dao,demilich,diakk,drider,duergar,elf,firebat,frog,gargoyle Data ghast,ghost,giant,githyanki,gnoll,gnome,goblin,golem,grell,grimlock Data grue,hornet,horror,hulk,hydra,kenku,killer,kobold,lamprey,lich,lion Data lizard,mage,margoyle,meenlock,mephit,mimic,minotaur,mummy,norker,ogre Data orc,otyugh,owlbear,pech,pedipalp,phantom,phycomid,piercer,planetar Data quaggoth,rakshasa,rat,reptile,scorpion,shocker,skeleton,slaad,slime Data slug,snake,solifugid,spectator,spectre,spider,stalker,stirge,tarrasque Data thoquaa,toad,troglodyte,troll,ustilagor,vampire,verbeeg,vulching,weasel Data webbird,wight,wraith,wyvern,demon